From 5be6db0eaf3f31f3a1d02ec476551c6d2c6bc3a4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 May 2016 17:59:55 +0300 Subject: [PATCH 001/309] Use official GHC-8.0.1 --- stack-ghc-8.0.yaml | 23 +++++++---------------- stack-lts-2.yaml | 4 ++-- stack-lts-3.yaml | 6 +++--- stack-lts-4.yaml | 4 ++-- stack-lts-5.yaml | 4 ++-- 5 files changed, 16 insertions(+), 25 deletions(-) diff --git a/stack-ghc-8.0.yaml b/stack-ghc-8.0.yaml index 592b2ca4..90f9616d 100644 --- a/stack-ghc-8.0.yaml +++ b/stack-ghc-8.0.yaml @@ -1,20 +1,7 @@ -flags: - time-locale-compat: - old-locale: false +resolver: ghc-8.0.1 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 @@ -61,6 +48,7 @@ extra-deps: - http-client-tls-0.2.4 - http-link-header-1.0.1 - http-types-0.9 +- HUnit-1.3.1.1 - iso8601-time-0.1.4 - kan-extensions-5.0.1 - keys-3.11 @@ -77,6 +65,7 @@ extra-deps: - prelude-extras-0.4.0.3 - primitive-0.6.1.0 - profunctors-5.2 +- QuickCheck-2.8.2 - quickcheck-io-0.1.2 - random-1.1 - safe-0.3.9 @@ -85,6 +74,7 @@ extra-deps: - semigroups-0.18.1 - setenv-0.1.1.3 - socks-0.5.5 +- StateVar-1.1.0.4 - stm-2.4.4.1 - streaming-commons-0.1.15.5 - syb-0.6 @@ -106,5 +96,6 @@ extra-deps: - 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 +flags: + time-locale-compat: + old-locale: false diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 5a8eb996..d909cd7e 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -1,6 +1,7 @@ +resolver: lts-2.22 packages: - '.' -- 'samples/' +- samples/ extra-deps: - aeson-extra-0.2.3.0 - asn1-parse-0.9.4 @@ -17,7 +18,6 @@ extra-deps: - x509-store-1.6.1 - x509-system-1.6.3 - x509-validation-1.6.3 -resolver: lts-2.22 flags: github: aeson-compat: false diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 7b68091a..5162f85f 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -1,6 +1,7 @@ +resolver: lts-3.22 packages: - '.' -- 'samples/' +- samples/ extra-deps: - base-compat-0.9.1 - cryptonite-0.15 @@ -8,7 +9,6 @@ extra-deps: - iso8601-time-0.1.4 - memory-0.12 - tls-1.3.8 -resolver: lts-3.22 flags: github: - aeson-compat: false + aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index e73113f5..ab1937e3 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -1,8 +1,8 @@ +resolver: lts-4.2 packages: - '.' -- 'samples/' +- 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 index c0228d93..163be5ba 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -1,5 +1,5 @@ +resolver: lts-5.16 packages: - '.' -- 'samples/' +- samples/ extra-deps: [] -resolver: lts-5.16 From 30ba6832c84aac346fba8365b5d19400799b7f8c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 May 2016 21:24:50 +0300 Subject: [PATCH 002/309] Add integer-simple none constraint --- travis-install.sh | 6 +++--- travis-script.sh | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/travis-install.sh b/travis-install.sh index 911eddb1..4ab1f882 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -1,4 +1,4 @@ -set -e +set -ex case $BUILD in stack) @@ -23,7 +23,7 @@ case $BUILD in fi cabal update -v sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt + cabal install --constraint="integer-simple installed" --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 @@ -36,7 +36,7 @@ case $BUILD in 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; + cabal install --constraint="integer-simple installed" --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss diff --git a/travis-script.sh b/travis-script.sh index 6303342b..0b38968a 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -13,7 +13,7 @@ case $BUILD in ;; cabal) if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + cabal configure --constraint="integer-simple installed" --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 From 371a7c446683095f753507129645a19270406a60 Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Fri, 20 May 2016 14:48:44 -0500 Subject: [PATCH 003/309] Change repoMasterBranch to repoDefaultBranch --- src/GitHub/Data/Repos.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 91e9b4db..c0dc54ef 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -58,7 +58,7 @@ data Repo = Repo { ,repoOwner :: !SimpleOwner ,repoName :: !(Name Repo) ,repoLanguage :: !(Maybe Language) - ,repoMasterBranch :: !(Maybe Text) + ,repoDefaultBranch :: !(Maybe Text) ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) ,repoUrl :: !Text @@ -176,7 +176,7 @@ instance FromJSON Repo where <*> o .: "owner" <*> o .: "name" <*> o .:? "language" - <*> o .:? "master_branch" + <*> o .:? "default_branch" <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" From 769892a8ae2ce9d82f5d907ff68070fe51d1101c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 00:16:29 +0300 Subject: [PATCH 004/309] Add repoDefaultBranch-test --- spec/GitHub/ReposSpec.hs | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index bda2780b..5b6ab190 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -2,14 +2,15 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where -import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, - languagesFor', userRepos') +import GitHub (Auth (..), Repo (..), RepoPublicity (..), + executeRequest, repositoryR) +import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) import qualified Data.HashMap.Strict as HM @@ -26,14 +27,22 @@ withAuth action = do spec :: Spec spec = do + describe "repositoryR" $ do + it "works" $ withAuth $ \auth -> do + er <- executeRequest auth $ repositoryR "phadej" "github" + er `shouldSatisfy` isRight + let Right r = er + -- https://github.com/phadej/github/pull/219 + repoDefaultBranch r `shouldBe` Just "master" + describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- currentUserRepos auth RepoPublicityAll + cs <- currentUserRepos auth RepoPublicityAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- userRepos' (Just auth) "phadej" RepoPublicityAll + cs <- userRepos' (Just auth) "phadej" RepoPublicityAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do From e44dc58f94b263784860dad28a4d7747579492fc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 09:09:06 +0300 Subject: [PATCH 005/309] Update CHANGELOG so far --- CHANGELOG.md | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 103e2629..43121aa8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,12 @@ -Changes for 0.14.3 - +Changes for 0.15.0 + +- Reworked `PullRequest` (notably `pullRequestsFor`) +- GHC-8.0.1 support +- Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` +- Add `listTeamReposR` +- Add `myStarredAcceptStarR` +- Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - -Changes for 0.14.2 - - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` Changes for 0.14.1 From 8294eab6d6a4eda907219a979630050b9e6d227b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 09:22:52 +0300 Subject: [PATCH 006/309] Remove uses of BS8.pack --- src/GitHub/Data/Webhooks/Validate.hs | 26 ++++++++++++++------------ src/GitHub/Endpoints/Issues.hs | 15 ++++++++------- src/GitHub/Endpoints/Repos.hs | 16 +++++++++------- src/GitHub/Endpoints/Repos/Commits.hs | 10 +++++----- 4 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 0ca26283..3915fbbc 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -14,28 +14,30 @@ module GitHub.Data.Webhooks.Validate ( import Prelude () import Prelude.Compat -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 (HMAC, SHA1, hmac, hmacGetDigest) +import Data.Byteable (constEqBytes, toBytes) +import Data.ByteString (ByteString) +import Data.Monoid ((<>)) +import Data.Text (Text) +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 where - shaOptBS = BS.pack <$> shaOpt + shaOptBS = TE.encodeUtf8 <$> shaOpt hexDigest = Hex.encode . toBytes . hmacGetDigest - hm = hmac (BS.pack secret) payload :: HMAC SHA1 + hm = hmac (TE.encodeUtf8 secret) payload :: HMAC SHA1 sign = "sha1=" <> hexDigest hm diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index f3e7a6c0..026b691c 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -33,7 +33,8 @@ import Data.Text (Text) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' @@ -81,18 +82,18 @@ issuesForRepoR user reqRepoName issueLimitations = convert AnyMilestone = ("milestone", Just "*") convert NoMilestone = ("milestone", Just "none") - convert (MilestoneId n) = ("milestone", Just . BS8.pack $ show n) + convert (MilestoneId n) = ("milestone", Just . TE.encodeUtf8 . T.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 (AssignedTo u) = ("assignee", Just . TE.encodeUtf8 . T.pack $ u) + convert (Mentions u) = ("mentioned", Just . TE.encodeUtf8 . T.pack $ u) + convert (Labels l) = ("labels", Just . TE.encodeUtf8 . T.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) + convert (PerPage n) = ("per_page", Just . TE.encodeUtf8 . T.pack $ show n) + convert (Since t) = ("since", Just . TE.encodeUtf8 . T.pack $ formatISO8601 t) -- Creating new issues. diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d053d461..0069ec1c 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -64,12 +64,14 @@ import Prelude.Compat import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) +import Data.Text (Text) import Data.Vector (Vector) import GitHub.Data import GitHub.Request -import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] @@ -313,26 +315,26 @@ branchesForR user repo = -- | 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 :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) contentsFor = contentsFor' Nothing -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- With Authentication -- -- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing -contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) +contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) contentsFor' auth user repo path ref = executeRequestMaybe auth $ contentsForR user repo path ref contentsForR :: Name Owner -> Name Repo - -> String -- ^ file or directory - -> Maybe String -- ^ Git commit + -> 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 + Query ["repos", toPathPart user, toPathPart repo, "contents", T.unpack path] qs where - qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref + qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref -- | The contents of a README file in a repo, given the repo owner and name -- diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 16a68c0e..2fad1c04 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -27,9 +27,9 @@ module GitHub.Endpoints.Repos.Commits ( 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 qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import GitHub.Data import GitHub.Request @@ -38,8 +38,8 @@ renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteStr 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) +renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) +renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) -- | The commit history for a repo. -- From 13cfa732e7060570531839d2bd13c111fd4a1ff8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 17:31:00 +0300 Subject: [PATCH 007/309] Enable space-leak detection in CI --- .travis.yml | 3 +++ stack-lts-5.yaml | 2 +- travis-install.sh | 16 +++++++++++----- travis-script.sh | 20 +++++++++++++++----- 4 files changed, 30 insertions(+), 11 deletions(-) diff --git a/.travis.yml b/.travis.yml index 34081ed3..a6c2ed92 100644 --- a/.travis.yml +++ b/.travis.yml @@ -57,6 +57,9 @@ matrix: - env: BUILD=stack STACK_YAML=stack-lts-4.yaml compiler: ": #stack LTS4 OSX" os: osx + - env: BUILD=stack-space-leak + compiler: ": #STACK - space leak" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} before_install: - unset CC diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 163be5ba..127719a3 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -1,4 +1,4 @@ -resolver: lts-5.16 +resolver: lts-5.17 packages: - '.' - samples/ diff --git a/travis-install.sh b/travis-install.sh index 4ab1f882..61fc1fd6 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -1,21 +1,27 @@ set -ex case $BUILD in - stack) + 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 + + if [ $BUILD == "stack-space-leak" ]; then + stack build --test --fast --library-profiling --ghc-options=-rtsopts --only-dependencies + else + stack --no-terminal test --only-dependencies + fi ;; 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 + 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 diff --git a/travis-script.sh b/travis-script.sh index 0b38968a..ef51e715 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -1,14 +1,24 @@ -set -e +set -ex + +SAMPLE_EXES="show-user list-followers list-following operational" 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 + for testbin in $SAMPLE_EXES; do + echo "Running " $testbin + stack exec github-$testbin + done + ;; + stack-space-leak) + stack --no-terminal test --fast --library-profiling --ghc-options=-rtsopts --test-arguments='+RTS -K1K' github + stack --no-terminal build --fast --library-profiling --ghc-options=-rtsopts --executable-profiling --test-arguments='+RTS -K1K' github-samples + + for testbin in $SAMPLE_EXES; do + echo "Running " $testbin + stack exec github-$testbin done ;; cabal) From 0e0f5d0ae1129e8d5d0af9e2371eedcb85ff10ad Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 18:06:33 +0300 Subject: [PATCH 008/309] FetchCount --- samples/Users/Followers/ListFollowers.hs | 2 +- samples/Users/Followers/ListFollowing.hs | 2 +- spec/GitHub/ActivitySpec.hs | 6 +++-- spec/GitHub/CommitsSpec.hs | 6 +++-- spec/GitHub/IssuesSpec.hs | 2 +- spec/GitHub/PullRequestsSpec.hs | 2 +- spec/GitHub/UsersSpec.hs | 6 +++-- src/GitHub/Data/Request.hs | 24 ++++++++++++++++- src/GitHub/Endpoints/Activity/Starring.hs | 16 ++++++------ src/GitHub/Endpoints/Activity/Watching.hs | 8 +++--- src/GitHub/Endpoints/Gists.hs | 4 +-- src/GitHub/Endpoints/Gists/Comments.hs | 4 +-- src/GitHub/Endpoints/GitData/References.hs | 4 +-- src/GitHub/Endpoints/Issues.hs | 4 +-- src/GitHub/Endpoints/Issues/Comments.hs | 4 +-- src/GitHub/Endpoints/Issues/Events.hs | 8 +++--- src/GitHub/Endpoints/Issues/Labels.hs | 12 ++++----- src/GitHub/Endpoints/Issues/Milestones.hs | 4 +-- src/GitHub/Endpoints/Organizations.hs | 4 +-- src/GitHub/Endpoints/Organizations/Members.hs | 6 ++--- src/GitHub/Endpoints/Organizations/Teams.hs | 14 +++++----- src/GitHub/Endpoints/PullRequests.hs | 12 ++++----- .../Endpoints/PullRequests/ReviewComments.hs | 4 +-- src/GitHub/Endpoints/Repos.hs | 26 +++++++++---------- src/GitHub/Endpoints/Repos/Collaborators.hs | 4 +-- src/GitHub/Endpoints/Repos/Comments.hs | 8 +++--- src/GitHub/Endpoints/Repos/Commits.hs | 6 ++--- src/GitHub/Endpoints/Repos/Forks.hs | 4 +-- src/GitHub/Endpoints/Repos/Webhooks.hs | 4 +-- src/GitHub/Endpoints/Users/Followers.hs | 8 +++--- src/GitHub/Request.hs | 8 ++++-- 31 files changed, 129 insertions(+), 97 deletions(-) diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index 8f608f61..a5ef346c 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..171f2fba 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/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 71d62f1a..aaee99a7 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -2,6 +2,8 @@ {-# 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 +31,11 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" Nothing + cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ myStarredAcceptStarR (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..2ca4f1a4 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -2,6 +2,8 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where +import qualified GitHub + import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', commitsForR, diffR, mkName) @@ -39,7 +41,7 @@ spec = do -- 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 <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -48,7 +50,7 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 30) + cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 354a84cb..a550ac63 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -25,7 +25,7 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo [] Nothing + GitHub.issuesForRepoR owner repo [] GitHub.FetchAll cs `shouldSatisfy` isRight where repos = diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 9ff0f3e6..4bb93796 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -26,7 +26,7 @@ spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts Nothing + GitHub.pullRequestsForR owner repo opts GitHub.FetchAll cs `shouldSatisfy` isRight where repos = diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 99842347..5c578c9c 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -10,6 +10,8 @@ import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) +import qualified GitHub + import GitHub.Data (Auth (..), Organization (..), User (..), fromOwner) import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', @@ -67,10 +69,10 @@ spec = do describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" (Just 10) + us <- executeRequest 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 <- executeRequest auth $ usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 5ee1c901..4f60c293 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -18,6 +18,7 @@ module GitHub.Data.Request ( toMethod, StatusMap(..), MergeResult(..), + FetchCount(..), Paths, IsPathPart(..), QueryString, @@ -106,6 +107,27 @@ instance Hashable (StatusMap a) where hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int) +-- | 'PagedQuery' returns just some results, using this data we can specify how +-- many pages we want to fetch. +data FetchCount = FetchAtLeast !Word | FetchAll + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +-- | This instance is there mostly for 'fromInteger'. +instance Num FetchCount where + fromInteger = FetchAtLeast . fromInteger + + FetchAtLeast a + FetchAtLeast b = FetchAtLeast (a * b) + _ + _ = FetchAll + + FetchAtLeast a * FetchAtLeast b = FetchAtLeast (a * b) + _ * _ = FetchAll + + abs = error "abs @FetchCount: not implemented" + signum = error "signum @FetchCount: not implemented" + negate = error "negate @FetchCount: not implemented" + +instance Hashable FetchCount + ------------------------------------------------------------------------------ -- Github request ------------------------------------------------------------------------------ @@ -118,7 +140,7 @@ instance Hashable (StatusMap a) where -- /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) + PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> FetchCount -> 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 diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 86828213..0b7c5ea0 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -29,11 +29,11 @@ import GitHub.Request -- > 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 + executeRequestMaybe auth $ stargazersForR user repo FetchAll -- | 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"] [] @@ -42,31 +42,31 @@ stargazersForR user repo = -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user Nothing + executeRequestMaybe auth $ reposStarredByR user FetchAll -- | 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 + executeRequest auth $ myStarredR FetchAll -- | All the repos starred by the authenticated user. -- See -myStarredR :: Maybe Count -> Request 'True (Vector Repo) +myStarredR :: FetchCount -> 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 + executeRequest auth $ myStarredAcceptStarR FetchAll -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: Maybe Count -> Request 'True (Vector RepoStarred) +myStarredAcceptStarR :: FetchCount -> Request 'True (Vector RepoStarred) myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 7dc93299..f128832d 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -32,11 +32,11 @@ watchersFor = watchersFor' Nothing -- > 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 + executeRequestMaybe auth $ watchersForR user repo FetchAll -- | 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 @@ -52,10 +52,10 @@ reposWatchedBy = reposWatchedBy' Nothing -- > reposWatchedBy' (Just (User (user, password))) "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = - executeRequestMaybe auth $ reposWatchedByR user Nothing + executeRequestMaybe auth $ reposWatchedByR user FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 537f3626..4aa959dc 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -23,7 +23,7 @@ import GitHub.Request -- > 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 + executeRequestMaybe auth $ gistsR user FetchAll -- | The list of all public gists created by the user. -- @@ -33,7 +33,7 @@ gists = gists' Nothing -- | List gists. -- See -gistsR :: Name Owner -> Maybe Count -> Request k (Vector Gist) +gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 0298e1a0..e7ed852f 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -23,11 +23,11 @@ import GitHub.Request -- > commentsOn "1174060" commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) commentsOn gid = - executeRequest' $ commentsOnR gid Nothing + executeRequest' $ commentsOnR gid FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 7a1a5137..73418b72 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -50,7 +50,7 @@ referenceR user repo ref = -- > 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 + executeRequestMaybe auth $ referencesR user repo FetchAll -- | The history of references for a repo. -- @@ -60,7 +60,7 @@ references = references' Nothing -- | 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"] [] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 026b691c..50463b16 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -63,7 +63,7 @@ issueR user reqRepoName reqIssueNumber = -- > 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 + executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations FetchAll -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the @IssueLimitation@ data type. @@ -74,7 +74,7 @@ issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See -issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> Maybe Count -> Request k (Vector Issue) +issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> FetchCount -> Request k (Vector Issue) issuesForRepoR user reqRepoName issueLimitations = PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index a6f90234..20371aee 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -50,11 +50,11 @@ comments = comments' Nothing -- > 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 + executeRequestMaybe auth $ commentsR user repo iid FetchAll -- | List comments on an issue. -- See -commentsR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueComment) +commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 8e555c2d..3a6f73d4 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -34,11 +34,11 @@ eventsForIssue = eventsForIssue' Nothing -- > 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 + executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll -- | 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 Event) eventsForIssueR user repo iid = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] @@ -53,11 +53,11 @@ eventsForRepo = eventsForRepo' Nothing -- > 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 + executeRequestMaybe auth $ eventsForRepoR user repo FetchAll -- | 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 Event) eventsForRepoR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 81ad0d50..a03bc94c 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -58,11 +58,11 @@ labelsOnRepo = labelsOnRepo' Nothing -- > 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 + executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll -- | 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"] [] @@ -152,11 +152,11 @@ labelsOnIssue = labelsOnIssue' Nothing -- > 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 + executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll -- | 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"] [] @@ -251,10 +251,10 @@ labelsOnMilestone = labelsOnMilestone' Nothing -- > 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 + executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 91447df2..8e793154 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -30,11 +30,11 @@ milestones = milestones' Nothing -- > 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 + executeRequestMaybe auth $ milestonesR user repo FetchAll -- | List milestones for a repository. -- See -milestonesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Milestone) +milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index d10d745a..7421a74d 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -23,7 +23,7 @@ import GitHub.Request -- > 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 + executeRequestMaybe auth $ publicOrganizationsForR org FetchAll -- | List user organizations. The public organizations for a user, given the user's login. -- @@ -33,7 +33,7 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See -publicOrganizationsForR :: Name User -> Maybe Count -> Request k (Vector SimpleOrganization) +publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 398184c1..1e321f39 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -25,7 +25,7 @@ import GitHub.Request -- > membersOf' (Just $ OAuth "token") "thoughtbot" membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = - executeRequestMaybe auth $ membersOfR org Nothing + executeRequestMaybe auth $ membersOfR org FetchAll -- | All the users who are members of the specified organization, -- | without authentication. @@ -37,13 +37,13 @@ membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser) +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 :: 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 diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index bd7a9784..13178fe9 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -52,7 +52,7 @@ import GitHub.Request -- > teamsOf' (Just $ OAuth "token") "thoughtbot" teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = - executeRequestMaybe auth $ teamsOfR org Nothing + executeRequestMaybe auth $ teamsOfR org FetchAll -- | List the public teams of an Owner. -- @@ -62,7 +62,7 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See -teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam) +teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. @@ -134,7 +134,7 @@ deleteTeamR tid = -- | List team members. -- -- See -listTeamMembersR :: Id Team -> TeamMemberRole -> Maybe Count -> Request 'True (Vector SimpleUser) +listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'True (Vector SimpleUser) listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of @@ -147,11 +147,11 @@ listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role -- -- > 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 +listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll -- | Query team repositories. -- See -listTeamReposR :: Id Team -> Maybe Count -> Request k (Vector Repo) +listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) listTeamReposR tid = PagedQuery ["teams", toPathPart tid, "repos"] [] -- | Retrieve repositories for a team. @@ -210,9 +210,9 @@ deleteTeamMembershipForR tid user = -- -- > listTeamsCurrent' (OAuth "token") listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) -listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing +listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See -listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team) +listTeamsCurrentR :: FetchCount -> Request 'True (Vector Team) listTeamsCurrentR = PagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 5cdc15fa..bd50e32f 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -41,13 +41,13 @@ import Data.Vector (Vector) -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions Nothing + executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions FetchAll -- | List pull requests. -- See pullRequestsForR :: Name Owner -> Name Repo -> PullRequestOptions -- ^ State - -> Maybe Count + -> FetchCount -> Request k (Vector SimplePullRequest) pullRequestsForR user repo opts = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] @@ -114,7 +114,7 @@ updatePullRequestR user repo prid epr = -- > 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 + executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. @@ -125,7 +125,7 @@ pullRequestCommitsIO = pullRequestCommits' Nothing -- | 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 -> Id PullRequest -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] @@ -136,7 +136,7 @@ pullRequestCommitsR user repo prid = -- > 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 + executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. @@ -147,7 +147,7 @@ pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 24402266..9aedce0d 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -22,11 +22,11 @@ import GitHub.Request -- > 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 + executeRequest' $ pullRequestReviewCommentsR user repo prid FetchAll -- | List comments on a pull request. -- See -pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Comment) +pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) pullRequestReviewCommentsR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 0069ec1c..6938d60c 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -83,11 +83,11 @@ repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) currentUserRepos auth publicity = - executeRequest auth $ currentUserReposR publicity Nothing + executeRequest auth $ currentUserReposR publicity FetchAll -- | List your repositories. -- See -currentUserReposR :: RepoPublicity -> Maybe Count -> Request k(Vector Repo) +currentUserReposR :: RepoPublicity -> FetchCount -> Request k(Vector Repo) currentUserReposR publicity = PagedQuery ["user", "repos"] qs where @@ -106,11 +106,11 @@ userRepos = userRepos' Nothing -- > 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 + executeRequestMaybe auth $ userReposR user publicity FetchAll -- | List user repositories. -- See -userReposR :: Name Owner -> RepoPublicity -> Maybe Count -> Request k(Vector Repo) +userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = PagedQuery ["users", toPathPart user, "repos"] qs where @@ -128,11 +128,11 @@ organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- > 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 + executeRequestMaybe auth $ organizationReposR org publicity FetchAll -- | List organization repositories. -- See -organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> Request k (Vector Repo) +organizationReposR :: Name Organization -> RepoPublicity -> FetchCount -> Request k (Vector Repo) organizationReposR org publicity = PagedQuery ["orgs", toPathPart org, "repos"] qs where @@ -217,14 +217,14 @@ contributors = contributors' Nothing -- > 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 + executeRequestMaybe auth $ contributorsR user repo False FetchAll -- | List contributors. -- See contributorsR :: Name Owner -> Name Repo -> Bool -- ^ Include anonymous - -> Maybe Count + -> FetchCount -> Request k (Vector Contributor) contributorsR user repo anon = PagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs @@ -248,7 +248,7 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- > 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 + executeRequestMaybe auth $ contributorsR user repo True FetchAll -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. @@ -284,11 +284,11 @@ tagsFor = tagsFor' Nothing -- > 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 + executeRequestMaybe auth $ tagsForR user repo FetchAll -- | 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"] [] @@ -304,11 +304,11 @@ branchesFor = branchesFor' Nothing -- > 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 + executeRequestMaybe auth $ branchesForR user repo FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 34ffca78..732b8068 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -28,11 +28,11 @@ collaboratorsOn = collaboratorsOn' Nothing -- With authentication. collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = - executeRequestMaybe auth $ collaboratorsOnR user repo Nothing + executeRequestMaybe auth $ collaboratorsOnR user repo FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 95966ec6..bcc13a1c 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -35,11 +35,11 @@ commentsFor = commentsFor' Nothing -- > 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 + executeRequestMaybe auth $ commentsForR user repo FetchAll -- | 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"] [] @@ -55,11 +55,11 @@ commitCommentsFor = commitCommentsFor' Nothing -- > 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 + executeRequestMaybe auth $ commitCommentsForR user repo sha FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 2fad1c04..28baa0c2 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -57,7 +57,7 @@ commitsFor' auth user repo = -- | 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)) @@ -70,11 +70,11 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- > 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 + executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll 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 where diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index a8734a5c..779b6c89 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -28,10 +28,10 @@ forksFor = forksFor' Nothing -- > 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 + executeRequestMaybe auth $ forksForR user repo FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index fa225ac5..b8d1abe8 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -44,11 +44,11 @@ import GitHub.Request webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = - executeRequest auth $ webhooksForR user repo Nothing + executeRequest auth $ webhooksForR user repo FetchAll -- | 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"] [] diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index b1ee7690..bc255310 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -23,11 +23,11 @@ import GitHub.Request -- > usersFollowing "mike-burns" usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowing user = - executeRequest' $ usersFollowingR user Nothing + executeRequest' $ usersFollowingR user FetchAll -- | List followers of a user. -- See -usersFollowingR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) +usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. @@ -35,9 +35,9 @@ usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] -- > usersFollowedBy "mike-burns" usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowedBy user = - executeRequest' $ usersFollowedByR user Nothing + executeRequest' $ usersFollowedByR user FetchAll -- | List users followed by another user. -- See -usersFollowedByR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) +usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index d1118153..146d20fb 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -106,6 +106,10 @@ executeRequest auth req = do #endif pure x +lessFetchCount :: Int -> FetchCount -> Bool +lessFetchCount _ FetchAll = True +lessFetchCount i (FetchAtLeast j) = i < fromIntegral j + -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: Manager -> Auth @@ -124,7 +128,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ httpReq <- makeHttpRequest (Just auth) req performPagedRequest httpLbs' predicate httpReq where - predicate = maybe (const True) (\l' -> (< l') . V.length ) l + predicate v = lessFetchCount (V.length v) l Command m _ _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq @@ -167,7 +171,7 @@ executeRequestWithMgr' mgr req = runExceptT $ httpReq <- makeHttpRequest Nothing req performPagedRequest httpLbs' predicate httpReq where - predicate = maybe (const True) (\l' -> (< l') . V.length) l + predicate v = lessFetchCount (V.length v) l StatusQuery sm _ -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq From 5f2871b18e7f786e0abffd227ab4980dc7f51dfa Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 18:52:12 +0300 Subject: [PATCH 009/309] Introduce internal prelude --- .stylish-haskell.yaml | 6 +- github.cabal | 17 ++++++ samples/Teams/DeleteTeam.hs | 4 +- samples/Teams/EditTeam.hs | 4 +- samples/Teams/ListTeamsCurrent.hs | 4 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 4 +- .../Memberships/DeleteTeamMembershipFor.hs | 4 +- .../Memberships/TeamMembershipInfoFor.hs | 4 +- samples/Teams/TeamInfoFor.hs | 4 +- samples/src/Common.hs | 13 +--- src/GitHub/Auth.hs | 9 +-- src/GitHub/Data.hs | 7 +-- src/GitHub/Data/Activities.hs | 17 +----- src/GitHub/Data/Comments.hs | 17 +----- src/GitHub/Data/Content.hs | 20 +------ src/GitHub/Data/Definitions.hs | 3 - src/GitHub/Data/Gists.hs | 17 +----- src/GitHub/Data/GitData.hs | 18 +----- src/GitHub/Data/Id.hs | 9 +-- src/GitHub/Data/Issues.hs | 18 +----- src/GitHub/Data/Name.hs | 11 +--- src/GitHub/Data/PullRequests.hs | 19 +----- src/GitHub/Data/Repos.hs | 20 +------ src/GitHub/Data/Request.hs | 18 ++---- src/GitHub/Data/Search.hs | 16 +---- src/GitHub/Data/Teams.hs | 22 ++----- src/GitHub/Data/URL.hs | 13 +--- src/GitHub/Data/Webhooks.hs | 20 +------ src/GitHub/Data/Webhooks/Validate.hs | 7 +-- src/GitHub/Endpoints/Activity/Starring.hs | 4 +- src/GitHub/Endpoints/Activity/Watching.hs | 2 +- src/GitHub/Endpoints/Gists.hs | 2 +- src/GitHub/Endpoints/Gists/Comments.hs | 3 +- src/GitHub/Endpoints/GitData/Blobs.hs | 1 + src/GitHub/Endpoints/GitData/Commits.hs | 1 + src/GitHub/Endpoints/GitData/References.hs | 5 +- src/GitHub/Endpoints/GitData/Trees.hs | 2 +- src/GitHub/Endpoints/Issues.hs | 11 +--- src/GitHub/Endpoints/Issues/Comments.hs | 6 +- src/GitHub/Endpoints/Issues/Events.hs | 3 +- src/GitHub/Endpoints/Issues/Labels.hs | 2 - src/GitHub/Endpoints/Issues/Milestones.hs | 3 +- src/GitHub/Endpoints/Organizations.hs | 2 +- src/GitHub/Endpoints/Organizations/Members.hs | 4 +- src/GitHub/Endpoints/Organizations/Teams.hs | 9 +-- src/GitHub/Endpoints/PullRequests.hs | 6 +- .../Endpoints/PullRequests/ReviewComments.hs | 2 +- src/GitHub/Endpoints/Repos.hs | 13 +--- src/GitHub/Endpoints/Repos/Collaborators.hs | 2 +- src/GitHub/Endpoints/Repos/Comments.hs | 2 +- src/GitHub/Endpoints/Repos/Commits.hs | 9 +-- src/GitHub/Endpoints/Repos/Forks.hs | 2 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 8 +-- src/GitHub/Endpoints/Search.hs | 8 +-- src/GitHub/Endpoints/Users.hs | 2 +- src/GitHub/Endpoints/Users/Followers.hs | 3 +- src/GitHub/Internal/Prelude.hs | 59 +++++++++++++++++++ src/GitHub/Request.hs | 17 ++---- 58 files changed, 153 insertions(+), 385 deletions(-) create mode 100644 src/GitHub/Internal/Prelude.hs diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 0d13efa4..56d5acea 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -8,6 +8,8 @@ steps: - trailing_whitespace: {} columns: 80 language_extensions: - - MultiParamTypeClasses - - FlexibleContexts - DataKinds + - ExplicitForAll + - FlexibleContexts + - MultiParamTypeClasses + - StandaloneDeriving diff --git a/github.cabal b/github.cabal index e81c8ad6..a2144925 100644 --- a/github.cabal +++ b/github.cabal @@ -49,8 +49,23 @@ Library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src + default-extensions: + NoImplicitPrelude + DataKinds + DeriveDataTypeable + DeriveGeneric + OverloadedStrings + ScopedTypeVariables + other-extensions: + CPP + FlexibleContexts + FlexibleInstances + GADTs + KindSignatures + StandaloneDeriving exposed-modules: GitHub + GitHub.Internal.Prelude GitHub.Auth GitHub.Data GitHub.Data.Comments @@ -142,6 +157,8 @@ test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec + other-extensions: + TemplateHaskell other-modules: GitHub.ActivitySpec GitHub.CommitsSpec 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..7e3f63a1 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.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/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index aa7718ec..4e75aa6a 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.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/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index faad9435..b07bee73 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.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/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/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index a2ca4c8e..c128e8b8 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.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/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/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 09475664..dd56de97 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,12 +5,7 @@ -- module GitHub.Auth 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 qualified Data.ByteString as BS diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 65c48289..235558ba 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -49,10 +47,7 @@ module GitHub.Data ( module GitHub.Data.Webhooks, ) where -import Prelude () -import Prelude.Compat - -import Data.Text (Text) +import GitHub.Internal.Prelude import GitHub.Auth import GitHub.Data.Activities diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 21e46ad5..4e62c32f 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,18 +5,8 @@ -- module GitHub.Data.Activities where -import Prelude () -import Prelude.Compat - -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 GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (Repo) +import GitHub.Internal.Prelude data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 61cbfca6..5983cb0e 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,21 +5,9 @@ -- module GitHub.Data.Comments where -import Prelude () -import Prelude.Compat - -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) - import GitHub.Data.Definitions import GitHub.Data.Id +import GitHub.Internal.Prelude data Comment = Comment { commentPosition :: !(Maybe Int) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 14519a5e..5fee96a4 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,20 +5,7 @@ -- module GitHub.Data.Content where -import Prelude () -import Prelude.Compat - -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 qualified Data.Text as T +import GitHub.Internal.Prelude data Content = ContentFile !ContentFileData @@ -91,7 +75,7 @@ instance FromJSON ContentItemType where case t of "file" -> return ItemFile "dir" -> return ItemDir - _ -> fail $ "Invalid ContentItemType: " ++ T.unpack t + _ -> fail $ "Invalid ContentItemType: " ++ unpack t instance FromJSON ContentInfo where parseJSON = withObject "ContentInfo" $ \o -> diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index a652e670..0a3f022b 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 53fc6cb4..0da92af8 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,23 +5,11 @@ -- 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 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) +import GitHub.Internal.Prelude data Gist = Gist { gistUser :: !SimpleUser diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 5a9012a8..f49b4b8a 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,22 +5,9 @@ -- 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.Internal.Prelude import qualified Data.Vector as V diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index bda2976c..e584c86e 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -11,12 +9,7 @@ module GitHub.Data.Id ( 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 -- | Numeric identifier. newtype Id entity = Id Int diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 15a931c4..c11b1cec 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,23 +5,10 @@ -- module GitHub.Data.Issues where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Id (Id) 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) +import GitHub.Internal.Prelude data Issue = Issue { issueClosedAt :: Maybe UTCTime diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 024f7175..43f48734 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -11,14 +9,7 @@ module GitHub.Data.Name ( 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 GitHub.Internal.Prelude newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index f7915881..9e6746e3 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -31,25 +28,11 @@ module GitHub.Data.PullRequests ( setPullRequestOptionsBase, ) where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) - -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 GitHub.Internal.Prelude import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index c0dc54ef..4f7e9ede 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | @@ -14,25 +11,10 @@ -- orphan-ish instance. module GitHub.Data.Repos where -import Prelude () -import Prelude.Compat - 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.Internal.Prelude import qualified Data.HashMap.Strict as HM diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 4f60c293..e13368e8 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -1,11 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -25,21 +21,15 @@ module GitHub.Data.Request ( 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.Internal.Prelude +import GitHub.Data.Definitions (Count, QueryString) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) 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) - ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index c2c46198..6d0924ba 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,19 +5,8 @@ -- module GitHub.Data.Search where -import Prelude () -import Prelude.Compat - import GitHub.Data.Repos (Repo) - -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) +import GitHub.Internal.Prelude import qualified Data.Vector as V diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 694288a9..cb883864 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | @@ -8,24 +9,11 @@ -- module GitHub.Data.Teams where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions - -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) +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) +import GitHub.Internal.Prelude data Privacy = PrivacyClosed diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 9ab236df..5dea2a7e 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -10,16 +8,7 @@ module GitHub.Data.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 -- | Data representing URLs in responses. -- diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index b52b867d..dbc5695a 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,21 +5,8 @@ -- 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.Internal.Prelude import qualified Data.Map as M diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 3915fbbc..b8e8fe9b 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -11,14 +9,11 @@ module GitHub.Data.Webhooks.Validate ( isValidPayload ) where -import Prelude () -import Prelude.Compat +import GitHub.Internal.Prelude import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) import Data.Byteable (constEqBytes, toBytes) import Data.ByteString (ByteString) -import Data.Monoid ((<>)) -import Data.Text (Text) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 0b7c5ea0..d08645b2 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,10 +17,10 @@ module GitHub.Endpoints.Activity.Starring ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Auth import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The list of users that have starred the specified Github repo. -- diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index f128832d..95ab457e 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -15,7 +15,7 @@ module GitHub.Endpoints.Activity.Watching ( module GitHub.Data, ) where -import Data.Vector (Vector) +import GitHub.Internal.Prelude import GitHub.Auth import GitHub.Data import GitHub.Request diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 4aa959dc..ead659ec 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -14,9 +14,9 @@ module GitHub.Endpoints.Gists ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The list of all gists created by the user -- diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index e7ed852f..1ca8a23c 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -13,10 +13,9 @@ module GitHub.Endpoints.Gists.Comments ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the comments on a Gist, given the Gist ID. -- diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index f473b09a..b9c3d5dd 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -14,6 +14,7 @@ module GitHub.Endpoints.GitData.Blobs ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | Query a blob by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index c4c51ef5..6bdd51d7 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -13,6 +13,7 @@ module GitHub.Endpoints.GitData.Commits ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | A single commit, by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 73418b72..8db53bfc 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -20,11 +19,9 @@ module GitHub.Endpoints.GitData.References ( module GitHub.Data, ) where -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | A single reference by the ref name. -- diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 661737a0..fecc3a27 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -18,6 +17,7 @@ module GitHub.Endpoints.GitData.Trees ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | A tree for a SHA1. -- diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 50463b16..6ff8f763 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -25,14 +23,9 @@ module GitHub.Endpoints.Issues ( ) where import GitHub.Data +import GitHub.Internal.Prelude 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.Text as T import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 20371aee..e12ec595 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,10 +18,7 @@ module GitHub.Endpoints.Issues.Comments ( module GitHub.Data, ) where -import Data.Aeson.Compat (encode) -import Data.Text (Text) -import Data.Vector (Vector) - +import GitHub.Internal.Prelude import GitHub.Data import GitHub.Request diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 3a6f73d4..fe8d4015 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -18,10 +18,9 @@ module GitHub.Endpoints.Issues.Events ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All events that have happened on an issue. -- diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index a03bc94c..b7e5192b 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 8e793154..5e4869c6 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -14,10 +14,9 @@ module GitHub.Endpoints.Issues.Milestones ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All milestones in the repo. -- diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 7421a74d..8bc3f746 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -14,9 +14,9 @@ module GitHub.Endpoints.Organizations ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The public organizations for a user, given the user's login, with authorization -- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 1e321f39..333279db 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -14,10 +13,9 @@ module GitHub.Endpoints.Organizations.Members ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the users who are members of the specified organization, -- | with or without authentication. diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 13178fe9..ff25a8e9 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -36,14 +34,9 @@ module GitHub.Endpoints.Organizations.Teams ( module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index bd50e32f..2578023e 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -32,9 +30,7 @@ module GitHub.Endpoints.PullRequests ( import GitHub.Data import GitHub.Request - -import Data.Aeson.Compat (Value, encode, object, (.=)) -import Data.Vector (Vector) +import GitHub.Internal.Prelude -- | All open pull requests for the repo, by owner and repo name. -- diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 9aedce0d..5c6528df 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -13,9 +13,9 @@ module GitHub.Endpoints.PullRequests.ReviewComments ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the comments on a pull request with the given ID. -- diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 6938d60c..10a6d85d 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -59,16 +55,9 @@ module GitHub.Endpoints.Repos ( module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Control.Applicative ((<|>)) -import Data.Aeson.Compat (encode) -import Data.Text (Text) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude import qualified Data.Text as T import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 732b8068..6753e9fa 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -14,9 +14,9 @@ module GitHub.Endpoints.Repos.Collaborators ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the users who have collaborated on a repo. -- diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index bcc13a1c..30db12ab 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -19,9 +19,9 @@ module GitHub.Endpoints.Repos.Comments ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the comments on a Github repo. -- diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 28baa0c2..01b971bc 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -24,16 +23,14 @@ module GitHub.Endpoints.Repos.Commits ( module GitHub.Data, ) where -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) +import GitHub.Internal.Prelude +import GitHub.Data +import GitHub.Request import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import GitHub.Data -import GitHub.Request - renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 779b6c89..76be374d 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -12,9 +12,9 @@ module GitHub.Endpoints.Repos.Forks ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the repos that are forked off the given repo. -- diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index b8d1abe8..39f4d762 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -33,14 +32,9 @@ module GitHub.Endpoints.Repos.Webhooks ( deleteRepoWebhookR, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index e92230a9..41d62d74 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,12 +18,11 @@ module GitHub.Endpoints.Search( module GitHub.Data, ) where -import Data.Text (Text) - -import qualified Data.Text.Encoding as TE - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude + +import qualified Data.Text.Encoding as TE -- | Perform a repository search. -- With authentication. diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 19876dab..477a121a 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -18,6 +17,7 @@ module GitHub.Endpoints.Users ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The information for a single user, by login name. -- With authentification diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index bc255310..719a85d6 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -13,10 +13,9 @@ module GitHub.Endpoints.Users.Followers ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the users following the given user. -- diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs new file mode 100644 index 00000000..39c95fb8 --- /dev/null +++ b/src/GitHub/Internal/Prelude.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE NoImplicitPrelude #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- This module may change between minor releases. Do not rely on it contents. +module GitHub.Internal.Prelude ( + module Prelude.Compat, + -- * Commonly used types + UTCTime, + HashMap, + Text, pack, unpack, + Vector, + -- * Commonly used typeclasses + Binary, + Data, Typeable, + Generic, + Hashable(..), + IsString(..), + NFData(..), genericRnf, + Semigroup(..), + -- * Aeson + FromJSON(..), ToJSON(..), Value(..), + encode, + withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, + -- * Control.Applicative + (<|>), + -- * Data.Maybe + catMaybes, + -- * Data.List + intercalate, + -- * Data.Time.ISO8601 + formatISO8601, + ) where + +import Control.Applicative ((<|>)) +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), encode, + object, withObject, withText, (.!=), (.:), + (.:?), (.=)) +import Data.Aeson.Types (typeMismatch) +import Data.Binary (Binary) +import Data.Binary.Orphans () +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable (..)) +import Data.HashMap.Strict (HashMap) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Semigroup (Semigroup (..)) +import Data.String (IsString (..)) +import Data.Text (Text, pack, unpack) +import Data.Time (UTCTime) +import Data.Time.ISO8601 (formatISO8601) +import Data.Vector (Vector) +import Data.Vector.Instances () +import GHC.Generics (Generic) +import Prelude.Compat diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 146d20fb..a27f8e8f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,12 +1,7 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -54,8 +49,7 @@ module GitHub.Request ( performPagedRequest, ) where -import Prelude () -import Prelude.Compat +import GitHub.Internal.Prelude #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except (MonadError (..)) @@ -66,11 +60,8 @@ import Control.Monad.Error (MonadError (..)) 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 Data.Aeson.Compat (eitherDecode) +import Data.List (find) import Network.HTTP.Client (CookieJar, HttpException (..), Manager, RequestBody (..), Response (..), From 802dd5491bdd2f564f9fedcdb8cb75c881c28dc0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 22:17:08 +0300 Subject: [PATCH 010/309] URL type for all *Url fields --- samples/Users/ShowUser.hs | 2 +- src/GitHub/Data/Comments.hs | 7 +++-- src/GitHub/Data/Content.hs | 7 +++-- src/GitHub/Data/Definitions.hs | 51 ++++++++++++++------------------- src/GitHub/Data/Gists.hs | 13 +++++---- src/GitHub/Data/GitData.hs | 35 +++++++++++----------- src/GitHub/Data/Issues.hs | 17 +++++------ src/GitHub/Data/PullRequests.hs | 10 +++---- src/GitHub/Data/Repos.hs | 17 +++++------ src/GitHub/Data/Request.hs | 2 +- src/GitHub/Data/Search.hs | 9 +++--- src/GitHub/Data/Teams.hs | 15 +++++----- src/GitHub/Data/Webhooks.hs | 5 ++-- src/GitHub/Internal/Prelude.hs | 8 +++--- 14 files changed, 99 insertions(+), 99 deletions(-) diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index b9c5d433..d5b8f09a 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -20,7 +20,7 @@ formatUser user = (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> (fromMaybe "" location) <> "\n" <> (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <> - htmlUrl <> "\t" <> tshow createdAt <> "\n" <> + GitHub.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <> "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> (fromMaybe "" bio) where diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 5983cb0e..c257d5e0 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -6,7 +6,8 @@ module GitHub.Data.Comments where import GitHub.Data.Definitions -import GitHub.Data.Id +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude data Comment = Comment { @@ -15,8 +16,8 @@ data Comment = Comment { ,commentBody :: !Text ,commentCommitId :: !(Maybe Text) ,commentUpdatedAt :: !UTCTime - ,commentHtmlUrl :: !(Maybe Text) - ,commentUrl :: !Text + ,commentHtmlUrl :: !(Maybe URL) + ,commentUrl :: !URL ,commentCreatedAt :: !(Maybe UTCTime) ,commentPath :: !(Maybe Text) ,commentUser :: !SimpleUser diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 5fee96a4..4347aab3 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -5,6 +5,7 @@ -- module GitHub.Data.Content where +import GitHub.Data.URL import GitHub.Internal.Prelude data Content @@ -45,9 +46,9 @@ data ContentInfo = ContentInfo { contentName :: !Text ,contentPath :: !Text ,contentSha :: !Text - ,contentUrl :: !Text - ,contentGitUrl :: !Text - ,contentHtmlUrl :: !Text + ,contentUrl :: !URL + ,contentGitUrl :: !URL + ,contentHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo where rnf = genericRnf diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 0a3f022b..8b64b405 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -5,28 +5,19 @@ -- 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 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. @@ -49,8 +40,8 @@ instance Binary OwnerType data SimpleUser = SimpleUser { simpleUserId :: !(Id User) , simpleUserLogin :: !(Name User) - , simpleUserAvatarUrl :: !Text - , simpleUserUrl :: !Text + , simpleUserAvatarUrl :: !URL + , simpleUserUrl :: !URL , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -61,8 +52,8 @@ 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) @@ -73,8 +64,8 @@ instance Binary SimpleOrganization 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) @@ -89,7 +80,7 @@ data User = User , userType :: !OwnerType -- ^ Should always be 'OwnerUser' , userCreatedAt :: !UTCTime , userPublicGists :: !Int - , userAvatarUrl :: !Text + , userAvatarUrl :: !URL , userFollowers :: !Int , userFollowing :: !Int , userHireable :: !(Maybe Bool) @@ -99,8 +90,8 @@ 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) @@ -116,13 +107,13 @@ 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) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 0da92af8..60e380c2 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -9,21 +9,22 @@ 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 data Gist = Gist { gistUser :: !SimpleUser - ,gistGitPushUrl :: !Text - ,gistUrl :: !Text + ,gistGitPushUrl :: !URL + ,gistUrl :: !URL ,gistDescription :: !(Maybe Text) ,gistCreatedAt :: !UTCTime ,gistPublic :: !Bool ,gistComments :: !Int ,gistUpdatedAt :: !UTCTime - ,gistHtmlUrl :: !Text + ,gistHtmlUrl :: !URL ,gistId :: !(Name Gist) ,gistFiles :: !(HashMap Text GistFile) - ,gistGitPullUrl :: !Text + ,gistGitPullUrl :: !URL } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf @@ -46,7 +47,7 @@ instance FromJSON Gist where data GistFile = GistFile { gistFileType :: !Text - ,gistFileRawUrl :: !Text + ,gistFileRawUrl :: !URL ,gistFileSize :: !Int ,gistFileLanguage :: !(Maybe Language) ,gistFileFilename :: !Text @@ -67,7 +68,7 @@ instance FromJSON GistFile where data GistComment = GistComment { gistCommentUser :: !SimpleUser - ,gistCommentUrl :: !Text + ,gistCommentUrl :: !URL ,gistCommentCreatedAt :: !UTCTime ,gistCommentBody :: !Text ,gistCommentUpdatedAt :: !UTCTime diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index f49b4b8a..1bc582fc 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -7,6 +7,7 @@ module GitHub.Data.GitData where import GitHub.Data.Definitions import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Vector as V @@ -31,7 +32,7 @@ instance Binary Stats data Commit = Commit { commitSha :: !(Name Commit) ,commitParents :: !(Vector Tree) - ,commitUrl :: !Text + ,commitUrl :: !URL ,commitGitCommit :: !GitCommit ,commitCommitter :: !(Maybe SimpleUser) ,commitAuthor :: !(Maybe SimpleUser) @@ -44,7 +45,7 @@ instance Binary Commit data Tree = Tree { treeSha :: !(Name Tree) - ,treeUrl :: !Text + ,treeUrl :: !URL ,treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -55,7 +56,7 @@ data GitTree = GitTree { gitTreeType :: !Text ,gitTreeSha :: !(Name GitTree) -- Can be empty for submodule - ,gitTreeUrl :: !(Maybe Text) + ,gitTreeUrl :: !(Maybe URL) ,gitTreeSize :: !(Maybe Int) ,gitTreePath :: !Text ,gitTreeMode :: !Text @@ -66,7 +67,7 @@ instance Binary GitTree data GitCommit = GitCommit { gitCommitMessage :: !Text - ,gitCommitUrl :: !Text + ,gitCommitUrl :: !URL ,gitCommitCommitter :: !GitUser ,gitCommitAuthor :: !GitUser ,gitCommitTree :: !Tree @@ -78,7 +79,7 @@ instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit data Blob = Blob { - blobUrl :: !Text + blobUrl :: !URL ,blobEncoding :: !Text ,blobContent :: !Text ,blobSha :: !(Name Blob) @@ -90,8 +91,8 @@ instance Binary Blob data Tag = Tag { tagName :: !Text - ,tagZipballUrl :: !Text - ,tagTarballUrl :: !Text + ,tagZipballUrl :: !URL + ,tagTarballUrl :: !URL ,tagCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -107,7 +108,7 @@ instance NFData Branch where rnf = genericRnf data BranchCommit = BranchCommit { branchCommitSha :: !Text - ,branchCommitUrl :: !Text + ,branchCommitUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf @@ -116,16 +117,16 @@ instance Binary BranchCommit data Diff = Diff { diffStatus :: !Text ,diffBehindBy :: !Int - ,diffPatchUrl :: !Text - ,diffUrl :: !Text + ,diffPatchUrl :: !URL + ,diffUrl :: !URL ,diffBaseCommit :: !Commit ,diffCommits :: !(Vector Commit) ,diffTotalCommits :: !Int - ,diffHtmlUrl :: !Text + ,diffHtmlUrl :: !URL ,diffFiles :: !(Vector File) ,diffAheadBy :: !Int - ,diffDiffUrl :: !Text - ,diffPermalinkUrl :: !Text + ,diffDiffUrl :: !URL + ,diffPermalinkUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf @@ -141,7 +142,7 @@ instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject - ,gitReferenceUrl :: !Text + ,gitReferenceUrl :: !URL ,gitReferenceRef :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -151,7 +152,7 @@ instance Binary GitReference data GitObject = GitObject { gitObjectType :: !Text ,gitObjectSha :: !Text - ,gitObjectUrl :: !Text + ,gitObjectUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf @@ -167,9 +168,9 @@ instance NFData GitUser where rnf = genericRnf instance Binary GitUser data File = File { - fileBlobUrl :: !Text + fileBlobUrl :: !URL ,fileStatus :: !Text - ,fileRawUrl :: !Text + ,fileRawUrl :: !URL ,fileAdditions :: !Int ,fileSha :: !Text ,fileChanges :: !Int diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index c11b1cec..51a8d908 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -8,13 +8,14 @@ module GitHub.Data.Issues where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.PullRequests +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude data Issue = Issue { issueClosedAt :: Maybe UTCTime ,issueUpdatedAt :: UTCTime - ,issueEventsUrl :: Text - ,issueHtmlUrl :: Maybe Text + ,issueEventsUrl :: URL + ,issueHtmlUrl :: Maybe URL ,issueClosedBy :: Maybe SimpleUser ,issueLabels :: (Vector IssueLabel) ,issueNumber :: Int @@ -22,7 +23,7 @@ data Issue = Issue { ,issueUser :: SimpleUser ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: Text + ,issueUrl :: URL ,issueCreatedAt :: UTCTime ,issueBody :: Maybe Text ,issueState :: Text @@ -65,7 +66,7 @@ data Milestone = Milestone { ,milestoneClosedIssues :: Int ,milestoneDescription :: Maybe Text ,milestoneTitle :: Text - ,milestoneUrl :: Text + ,milestoneUrl :: URL ,milestoneCreatedAt :: UTCTime ,milestoneState :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -75,7 +76,7 @@ instance Binary Milestone data IssueLabel = IssueLabel { labelColor :: Text - ,labelUrl :: Text + ,labelUrl :: URL ,labelName :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -85,8 +86,8 @@ instance Binary IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime ,issueCommentUser :: SimpleUser - ,issueCommentUrl :: Text - ,issueCommentHtmlUrl :: Text + ,issueCommentUrl :: URL + ,issueCommentHtmlUrl :: URL ,issueCommentCreatedAt :: UTCTime ,issueCommentBody :: Text ,issueCommentId :: Int @@ -124,7 +125,7 @@ data Event = Event { eventActor :: !SimpleUser ,eventType :: !EventType ,eventCommitId :: !(Maybe Text) - ,eventUrl :: !Text + ,eventUrl :: !URL ,eventCreatedAt :: !UTCTime ,eventId :: !Int ,eventIssue :: !(Maybe Issue) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 9e6746e3..812c866f 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -46,7 +46,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !Text - , simplePullRequestIssueUrl :: !Text + , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL , simplePullRequestLinks :: !PullRequestLinks @@ -68,7 +68,7 @@ data PullRequest = PullRequest , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !Text - , pullRequestIssueUrl :: !Text + , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL , pullRequestLinks :: !PullRequestLinks @@ -165,9 +165,9 @@ instance NFData PullRequestEventType where rnf = genericRnf 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) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 4f7e9ede..9bcbf447 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -14,6 +14,7 @@ module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.HashMap.Strict as HM @@ -23,17 +24,17 @@ import Unsafe.Coerce (unsafeCoerce) #endif data Repo = Repo { - repoSshUrl :: !(Maybe Text) + repoSshUrl :: !(Maybe URL) ,repoDescription :: !(Maybe Text) ,repoCreatedAt :: !(Maybe UTCTime) - ,repoHtmlUrl :: !Text - ,repoSvnUrl :: !(Maybe Text) + ,repoHtmlUrl :: !URL + ,repoSvnUrl :: !(Maybe URL) ,repoForks :: !(Maybe Int) ,repoHomepage :: !(Maybe Text) ,repoFork :: !(Maybe Bool) - ,repoGitUrl :: !(Maybe Text) + ,repoGitUrl :: !(Maybe URL) ,repoPrivate :: !Bool - ,repoCloneUrl :: !(Maybe Text) + ,repoCloneUrl :: !(Maybe URL) ,repoSize :: !(Maybe Int) ,repoUpdatedAt :: !(Maybe UTCTime) ,repoWatchers :: !(Maybe Int) @@ -43,14 +44,14 @@ data Repo = Repo { ,repoDefaultBranch :: !(Maybe Text) ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) - ,repoUrl :: !Text + ,repoUrl :: !URL ,repoOpenIssues :: !(Maybe Int) ,repoHasWiki :: !(Maybe Bool) ,repoHasIssues :: !(Maybe Bool) ,repoHasDownloads :: !(Maybe Bool) ,repoParent :: !(Maybe RepoRef) ,repoSource :: !(Maybe RepoRef) - ,repoHooksUrl :: !Text + ,repoHooksUrl :: !URL ,repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -124,7 +125,7 @@ instance IsString Language where 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 + = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index e13368e8..188332a7 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -21,10 +21,10 @@ module GitHub.Data.Request ( Count, ) where -import GitHub.Internal.Prelude import GitHub.Data.Definitions (Count, QueryString) 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 diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index 6d0924ba..daaf0bc2 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -5,7 +5,8 @@ -- module GitHub.Data.Search where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Vector as V @@ -27,9 +28,9 @@ data Code = Code { codeName :: !Text ,codePath :: !Text ,codeSha :: !Text - ,codeUrl :: !Text - ,codeGitUrl :: !Text - ,codeHtmlUrl :: !Text + ,codeUrl :: !URL + ,codeGitUrl :: !URL + ,codeHtmlUrl :: !URL ,codeRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index cb883864..9ab433e9 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -13,6 +13,7 @@ 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 data Privacy = @@ -34,14 +35,14 @@ instance Binary Permission data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) - ,simpleTeamUrl :: !Text + ,simpleTeamUrl :: !URL ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. ,simpleTeamSlug :: !(Name Team) ,simpleTeamDescription :: !(Maybe Text) ,simpleTeamPrivacy :: !(Maybe Privacy) ,simpleTeamPermission :: !Permission - ,simpleTeamMembersUrl :: !Text - ,simpleTeamRepositoriesUrl :: !Text + ,simpleTeamMembersUrl :: !URL + ,simpleTeamRepositoriesUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf @@ -49,14 +50,14 @@ instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) - ,teamUrl :: !Text + ,teamUrl :: !URL ,teamName :: !(Name Team) ,teamSlug :: !Text ,teamDescription :: !(Maybe Text) ,teamPrivacy :: !(Maybe Privacy) ,teamPermission :: !Permission - ,teamMembersUrl :: !Text - ,teamRepositoriesUrl :: !Text + ,teamMembersUrl :: !URL + ,teamRepositoriesUrl :: !URL ,teamMembersCount :: !Int ,teamReposCount :: !Int ,teamOrganization :: !SimpleOrganization @@ -103,7 +104,7 @@ instance NFData ReqState where rnf = genericRnf instance Binary ReqState data TeamMembership = TeamMembership { - teamMembershipUrl :: !Text, + teamMembershipUrl :: !URL, teamMembershipRole :: !Role, teamMembershipReqState :: !ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index dbc5695a..1c9db40b 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -6,13 +6,14 @@ module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Map as M data RepoWebhook = RepoWebhook { - repoWebhookUrl :: !Text - ,repoWebhookTestUrl :: !Text + repoWebhookUrl :: !URL + ,repoWebhookTestUrl :: !URL ,repoWebhookId :: !(Id RepoWebhook) ,repoWebhookName :: !Text ,repoWebhookActive :: !Bool diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 39c95fb8..533fa1f2 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -21,7 +21,7 @@ module GitHub.Internal.Prelude ( NFData(..), genericRnf, Semigroup(..), -- * Aeson - FromJSON(..), ToJSON(..), Value(..), + FromJSON(..), ToJSON(..), Value(..), Object, encode, withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, -- * Control.Applicative @@ -37,9 +37,9 @@ module GitHub.Internal.Prelude ( import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), encode, - object, withObject, withText, (.!=), (.:), - (.:?), (.=)) +import Data.Aeson.Compat (FromJSON (..), Object, ToJSON (..), Value (..), + encode, object, withObject, withText, (.!=), + (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) import Data.Binary.Orphans () From d2f53c4eeaa70b85bc246e0fa31ebd663577fa09 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 24 May 2016 08:52:47 +0300 Subject: [PATCH 011/309] Change Parts to [Text] --- src/GitHub/Auth.hs | 2 +- src/GitHub/Data/Request.hs | 8 ++++---- src/GitHub/Endpoints/GitData/References.hs | 4 ++-- src/GitHub/Endpoints/Issues/Events.hs | 2 +- src/GitHub/Endpoints/Repos.hs | 3 +-- src/GitHub/Endpoints/Repos/Commits.hs | 2 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 4 ++-- src/GitHub/Request.hs | 17 ++++++++++------- 8 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index dd56de97..05ac6e30 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -15,7 +15,7 @@ type Token = BS.ByteString data Auth = BasicAuth BS.ByteString BS.ByteString | OAuth Token -- ^ token - | EnterpriseOAuth String -- custom API endpoint without + | EnterpriseOAuth Text -- custom API endpoint without -- trailing slash Token -- token deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 188332a7..7ccfbe37 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -34,16 +34,16 @@ import qualified Network.HTTP.Types.Method as Method -- Auxillary types ------------------------------------------------------------------------------ -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 -- | Http method of requests with body. data CommandMethod a where diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 8db53bfc..a96e847d 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -75,12 +75,12 @@ createReferenceR user repo newRef = -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: Name Owner -> Name Repo -> String -> IO (Either Error [GitReference]) +namespacedReferences :: Name Owner -> Name Repo -> Text -> IO (Either Error [GitReference]) namespacedReferences user repo namespace = executeRequest' $ namespacedReferencesR user repo namespace -- | Query namespaced references. -- See -namespacedReferencesR :: Name Owner -> Name Repo -> 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] [] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index fe8d4015..0581099e 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -77,4 +77,4 @@ event' auth user repo eid = -- See eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event 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/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 10a6d85d..6c5bb14e 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -59,7 +59,6 @@ import GitHub.Data import GitHub.Request import GitHub.Internal.Prelude -import qualified Data.Text as T import qualified Data.Text.Encoding as TE repoPublicityQueryString :: RepoPublicity -> QueryString @@ -321,7 +320,7 @@ contentsForR :: Name Owner -> Maybe Text -- ^ Git commit -> Request k Content contentsForR user repo path ref = - Query ["repos", toPathPart user, toPathPart repo, "contents", T.unpack path] qs + Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 01b971bc..ff11f31d 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -115,4 +115,4 @@ diff' auth user repo base headref = -- 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/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 39f4d762..5fa7b784 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -106,10 +106,10 @@ deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True 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/Request.hs b/src/GitHub/Request.hs index a27f8e8f..a8b5bf34 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -99,7 +99,7 @@ executeRequest auth req = do lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j +lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: Manager @@ -207,21 +207,21 @@ makeHttpRequest auth r = case r of req' <- makeHttpRequest auth req return $ setCheckStatus (Just sm) req' Query paths qs -> do - req <- parseUrl $ url paths + req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req PagedQuery paths qs _ -> do - req <- parseUrl $ url paths + req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req Command m paths body -> do - req <- parseUrl $ url paths + req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth @@ -232,10 +232,13 @@ makeHttpRequest auth r = case r of req' <- makeHttpRequest auth req return $ req' { requestHeaders = h <> requestHeaders req' } where - url :: Paths -> String - url paths = baseUrl ++ '/' : intercalate "/" paths + parseUrl' :: MonadThrow m => Text -> m HTTP.Request + parseUrl' = parseUrl . T.unpack - baseUrl :: String + url :: Paths -> Text + url paths = baseUrl <> "/" <> T.intercalate "/" paths + + baseUrl :: Text baseUrl = case auth of Just (EnterpriseOAuth endpoint _) -> endpoint _ -> "https://api.github.com" From 1a71bd8c7da0c0088311597ea738a7fc387ab3cc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 24 May 2016 08:54:46 +0300 Subject: [PATCH 012/309] More String to Text --- src/GitHub/Endpoints/PullRequests.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 2578023e..46aae86b 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -159,19 +159,19 @@ isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $ 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 -> Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> IO (Either Error MergeResult) mergePullRequest auth user repo prid commitMessage = executeRequest auth $ mergePullRequestR user repo prid commitMessage -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> Request 'True MergeResult +mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'True MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ 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 [] From 12825903777cf65524d4f150f29c3fd22db86a48 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Fri, 12 Aug 2016 15:48:45 -0400 Subject: [PATCH 013/309] Add API wrapper functions for fetching deploy keys - fetch list of all deploy keys - fetch deploy key by ID --- src/GitHub/Data/DeployKeys.hs | 30 ++++++++++++++++++++ src/GitHub/Endpoints/Repos/DeployKeys.hs | 35 ++++++++++++++++++++++++ 2 files changed, 65 insertions(+) create mode 100644 src/GitHub/Data/DeployKeys.hs create mode 100644 src/GitHub/Endpoints/Repos/DeployKeys.hs diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs new file mode 100644 index 00000000..0764b125 --- /dev/null +++ b/src/GitHub/Data/DeployKeys.hs @@ -0,0 +1,30 @@ +----------------------------------------------------------------------------- +-- | +-- 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 + +data RepoDeployKey = RepoDeployKey { + repoDeployKeyId :: !(Id RepoDeployKey) + ,repoDeployKeyKey :: !Text + ,repoDeployKeyUrl :: !URL + ,repoDeployKeyTitle :: !Text + ,repoDeployKeyVerified :: !Bool + ,repoDeployKeyCreatedAt :: !UTCTime + ,repoDeployKeyReadOnly :: !Bool +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON RepoDeployKey where + parseJSON = withObject "RepoDeployKey" $ \o -> + RepoDeployKey <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs new file mode 100644 index 00000000..bb32f000 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +-- The deploy keys API, as described at +-- +module GitHub.Endpoints.Repos.DeployKeys ( + -- * Querying deploy keys + deployKeysFor', + deployKeysForR, + deployKeyFor', + deployKeyForR, +) where + +import GitHub.Data +import GitHub.Request +import GitHub.Internal.Prelude + +-- * Querying deploy keys +deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) +deployKeysFor' auth user repo = + executeRequest auth $ deployKeysForR user repo FetchAll + +deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoDeployKey) +deployKeysForR user repo = + PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] + +deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) +deployKeyFor' auth user repo keyId = + executeRequest auth $ deployKeyForR user repo keyId + +deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request k RepoDeployKey +deployKeyForR user repo keyId = + Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] From 85b9970c3523350d49805fe917b41fffa50b5dc7 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Fri, 12 Aug 2016 16:26:24 -0400 Subject: [PATCH 014/309] Add API wrapper functions for creating/deleting deploy keys --- github.cabal | 2 + samples/github-samples.cabal | 162 +++++++++++------------ src/GitHub/Data.hs | 4 +- src/GitHub/Data/DeployKeys.hs | 20 +++ src/GitHub/Endpoints/Repos/DeployKeys.hs | 31 ++++- 5 files changed, 136 insertions(+), 83 deletions(-) diff --git a/github.cabal b/github.cabal index a2144925..8e719b6f 100644 --- a/github.cabal +++ b/github.cabal @@ -83,6 +83,7 @@ Library GitHub.Data.Teams GitHub.Data.Activities GitHub.Data.URL + GitHub.Data.DeployKeys GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Starring @@ -109,6 +110,7 @@ Library GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Webhooks + GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Followers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index eb607530..2bd437ee 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,4 +1,4 @@ --- This file has been generated from package.yaml by hpack version 0.13.0. +-- This file has been generated from package.yaml by hpack version 0.9.0. -- -- see: https://github.com/sol/hpack @@ -20,10 +20,10 @@ library Common default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs +executable github-edit-team + main-is: EditTeam.hs hs-source-dirs: - Teams/Memberships + Teams ghc-options: -Wall build-depends: base @@ -32,12 +32,17 @@ executable github-add-team-membership-for , text , github-samples other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor + DeleteTeam + ListRepos + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs +executable github-list-team-current + main-is: ListTeamsCurrent.hs hs-source-dirs: Teams ghc-options: -Wall @@ -48,19 +53,19 @@ executable github-delete-team , text , github-samples other-modules: + DeleteTeam EditTeam ListRepos - ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor Memberships.TeamMembershipInfoFor TeamInfoFor default-language: Haskell2010 -executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs +executable github-operational + main-is: Operational.hs hs-source-dirs: - Teams/Memberships + Operational ghc-options: -Wall build-depends: base @@ -68,13 +73,15 @@ executable github-delete-team-membership-for , github , text , github-samples - other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor + , http-client + , http-client-tls + , operational + , transformers + , transformers-compat default-language: Haskell2010 -executable github-edit-team - main-is: EditTeam.hs +executable github-list-team-repos + main-is: ListRepos.hs hs-source-dirs: Teams ghc-options: -Wall @@ -86,7 +93,7 @@ executable github-edit-team , github-samples other-modules: DeleteTeam - ListRepos + EditTeam ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor @@ -94,10 +101,10 @@ executable github-edit-team TeamInfoFor default-language: Haskell2010 -executable github-list-followers - main-is: ListFollowers.hs +executable github-delete-team + main-is: DeleteTeam.hs hs-source-dirs: - Users/Followers + Teams ghc-options: -Wall build-depends: base @@ -106,29 +113,35 @@ executable github-list-followers , text , github-samples other-modules: - Example - ListFollowing + EditTeam + ListRepos + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-list-followers-example - main-is: Example.hs +executable github-delete-team-membership-for + main-is: DeleteTeamMembershipFor.hs hs-source-dirs: - Users/Followers + Teams/Memberships ghc-options: -Wall build-depends: base , base-compat , github , text + , github-samples other-modules: - ListFollowers - ListFollowing + AddTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-list-following - main-is: ListFollowing.hs +executable github-show-user-2 + main-is: ShowUser2.hs hs-source-dirs: - Users/Followers + Users ghc-options: -Wall build-depends: base @@ -137,14 +150,16 @@ executable github-list-following , text , github-samples other-modules: - Example - ListFollowers + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser default-language: Haskell2010 -executable github-list-team-current - main-is: ListTeamsCurrent.hs +executable github-show-user + main-is: ShowUser.hs hs-source-dirs: - Teams + Users ghc-options: -Wall build-depends: base @@ -153,19 +168,16 @@ executable github-list-team-current , text , github-samples other-modules: - DeleteTeam - EditTeam - ListRepos - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser2 default-language: Haskell2010 -executable github-list-team-repos - main-is: ListRepos.hs +executable github-list-following + main-is: ListFollowing.hs hs-source-dirs: - Teams + Users/Followers ghc-options: -Wall build-depends: base @@ -174,37 +186,29 @@ executable github-list-team-repos , text , github-samples other-modules: - DeleteTeam - EditTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor + Example + ListFollowers default-language: Haskell2010 -executable github-operational - main-is: Operational.hs +executable github-list-followers-example + main-is: Example.hs hs-source-dirs: - Operational + Users/Followers ghc-options: -Wall build-depends: base , base-compat , github , text - , github-samples - , http-client - , http-client-tls - , operational - , transformers - , transformers-compat + other-modules: + ListFollowers + ListFollowing default-language: Haskell2010 -executable github-show-user - main-is: ShowUser.hs +executable github-add-team-membership-for + main-is: AddTeamMembershipFor.hs hs-source-dirs: - Users + Teams/Memberships ghc-options: -Wall build-depends: base @@ -213,16 +217,14 @@ executable github-show-user , text , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 + DeleteTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-show-user-2 - main-is: ShowUser2.hs +executable github-team-membership-info-for + main-is: TeamMembershipInfoFor.hs hs-source-dirs: - Users + Teams/Memberships ghc-options: -Wall build-depends: base @@ -231,16 +233,14 @@ executable github-show-user-2 , text , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser + AddTeamMembershipFor + DeleteTeamMembershipFor default-language: Haskell2010 -executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs +executable github-list-followers + main-is: ListFollowers.hs hs-source-dirs: - Teams/Memberships + Users/Followers ghc-options: -Wall build-depends: base @@ -249,8 +249,8 @@ executable github-team-membership-info-for , text , github-samples other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor + Example + ListFollowing default-language: Haskell2010 executable github-teaminfo-for diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 235558ba..c63b7741 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -35,6 +35,7 @@ module GitHub.Data ( module GitHub.Data.Comments, module GitHub.Data.Content, module GitHub.Data.Definitions, + module GitHub.Data.DeployKeys, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, @@ -44,7 +45,7 @@ module GitHub.Data ( module GitHub.Data.Search, module GitHub.Data.Teams, module GitHub.Data.URL, - module GitHub.Data.Webhooks, + module GitHub.Data.Webhooks ) where import GitHub.Internal.Prelude @@ -54,6 +55,7 @@ import GitHub.Data.Activities import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions +import GitHub.Data.DeployKeys import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index 0764b125..c93f0b6d 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -28,3 +28,23 @@ instance FromJSON RepoDeployKey where <*> o .: "verified" <*> o .: "created_at" <*> o .: "read_only" + +data NewRepoDeployKey = NewRepoDeployKey { + newRepoDeployKeyKey :: !Text + ,newRepoDeployKeyTitle :: !Text + ,newRepoDeployKeyReadOnly :: !Bool +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance ToJSON NewRepoDeployKey where + toJSON (NewRepoDeployKey key title readOnly) = + object [ + "key" .= key + , "title" .= title + , "read_only" .= readOnly + ] + +instance FromJSON NewRepoDeployKey where + parseJSON = withObject "RepoDeployKey" $ \o -> + NewRepoDeployKey <$> o .: "key" + <*> o .: "title" + <*> o .: "read_only" diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index bb32f000..45dc0c3f 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -11,13 +11,21 @@ module GitHub.Endpoints.Repos.DeployKeys ( deployKeysForR, deployKeyFor', deployKeyForR, + + -- ** Create + createRepoDeployKey', + createRepoDeployKeyR, + + -- ** Delete + deleteRepoDeployKey', + deleteRepoDeployKeyR, ) where import GitHub.Data import GitHub.Request import GitHub.Internal.Prelude --- * Querying deploy keys +-- | Querying deploy keys deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) deployKeysFor' auth user repo = executeRequest auth $ deployKeysForR user repo FetchAll @@ -26,6 +34,7 @@ deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Rep deployKeysForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] +-- | Querying a deploy key deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) deployKeyFor' auth user repo keyId = executeRequest auth $ deployKeyForR user repo keyId @@ -33,3 +42,23 @@ deployKeyFor' auth user repo keyId = deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request k RepoDeployKey deployKeyForR user repo keyId = Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] + +-- | Create a deploy key +createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) +createRepoDeployKey' auth user repo key = + executeRequest auth $ createRepoDeployKeyR user repo key + +-- | Create a deploy key. +createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'True RepoDeployKey +createRepoDeployKeyR user repo key = + Command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) + +deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) +deleteRepoDeployKey' auth user repo keyId = + executeRequest auth $ deleteRepoDeployKeyR user repo keyId + +-- | Delete a deploy key. +-- See +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'True () +deleteRepoDeployKeyR user repo keyId = + Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty From 3c23ebbc3c871866299a102f019f33538ae82ec5 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Fri, 12 Aug 2016 17:14:29 -0400 Subject: [PATCH 015/309] Add usage examples - creating deploy key - listing all deploy keys - listing a deploy key by ID - deleting a deploy key --- samples/Repos/DeployKeys/CreateDeployKey.hs | 23 +++++++ samples/Repos/DeployKeys/DeleteDeployKey.hs | 14 +++++ samples/Repos/DeployKeys/ListDeployKeys.hs | 20 ++++++ samples/Repos/DeployKeys/ShowDeployKey.hs | 20 ++++++ samples/github-samples.cabal | 69 +++++++++++++++++++++ samples/package.yaml | 21 +++++++ 6 files changed, 167 insertions(+) create mode 100644 samples/Repos/DeployKeys/CreateDeployKey.hs create mode 100644 samples/Repos/DeployKeys/DeleteDeployKey.hs create mode 100644 samples/Repos/DeployKeys/ListDeployKeys.hs create mode 100644 samples/Repos/DeployKeys/ShowDeployKey.hs diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs new file mode 100644 index 00000000..20d4e02a --- /dev/null +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -0,0 +1,23 @@ +{-# 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 +import Data.List +import Data.Text (Text) + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKey <- DK.createRepoDeployKey' auth "your_owner" "your_repo" newDeployKey + case eDeployKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right deployKey) -> putStrLn $ show deployKey + +newDeployKey :: DK.NewRepoDeployKey +newDeployKey = DK.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..650d1c9a --- /dev/null +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub.Data.DeployKeys as DK +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth +import Data.List +import Data.Vector (toList) + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKeys <- DK.deployKeysFor' auth "your_owner" "your_repo" + 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..48e06b94 --- /dev/null +++ b/samples/Repos/DeployKeys/ShowDeployKey.hs @@ -0,0 +1,20 @@ +{-# 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/github-samples.cabal b/samples/github-samples.cabal index 2bd437ee..58555afa 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -80,6 +80,40 @@ executable github-operational , transformers-compat default-language: Haskell2010 +executable github-show-deploy-key + main-is: ShowDeployKey.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + CreateDeployKey + DeleteDeployKey + ListDeployKeys + default-language: Haskell2010 + +executable github-delete-deploy-key + main-is: DeleteDeployKey.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + CreateDeployKey + ListDeployKeys + ShowDeployKey + default-language: Haskell2010 + executable github-list-team-repos main-is: ListRepos.hs hs-source-dirs: @@ -122,6 +156,24 @@ executable github-delete-team TeamInfoFor default-language: Haskell2010 +executable github-list-deploy-keys-for + main-is: ListDeployKeys.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , vector + other-modules: + CreateDeployKey + DeleteDeployKey + ShowDeployKey + default-language: Haskell2010 + executable github-delete-team-membership-for main-is: DeleteTeamMembershipFor.hs hs-source-dirs: @@ -205,6 +257,23 @@ executable github-list-followers-example ListFollowing default-language: Haskell2010 +executable github-create-deploy-key + main-is: CreateDeployKey.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteDeployKey + ListDeployKeys + ShowDeployKey + default-language: Haskell2010 + executable github-add-team-membership-for main-is: AddTeamMembershipFor.hs hs-source-dirs: diff --git a/samples/package.yaml b/samples/package.yaml index af03e708..eae199e7 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -85,3 +85,24 @@ executables: - operational - transformers - transformers-compat + github-list-deploy-keys-for: + main: ListDeployKeys.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples + - vector + github-show-deploy-key: + main: ShowDeployKey.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples + github-create-deploy-key: + main: CreateDeployKey.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples + github-delete-deploy-key: + main: DeleteDeployKey.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples From 833cf0ff74cf01b9573d2d4e770c4dd60debdb4f Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Sun, 11 Sep 2016 15:37:06 -0400 Subject: [PATCH 016/309] Add WebhookPingEvent constructor for RepoWebhookEvent The relevant FromJSON and ToJSON instances have also been amended to parse and emit the "ping" string. --- src/GitHub/Data/Webhooks.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 1c9db40b..aa8101c5 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -40,6 +40,7 @@ data RepoWebhookEvent = | WebhookIssuesEvent | WebhookMemberEvent | WebhookPageBuildEvent + | WebhookPingEvent | WebhookPublicEvent | WebhookPullRequestReviewCommentEvent | WebhookPullRequestEvent @@ -107,6 +108,7 @@ instance FromJSON RepoWebhookEvent where parseJSON (String "issues") = pure WebhookIssuesEvent parseJSON (String "member") = pure WebhookMemberEvent parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "ping") = pure WebhookPingEvent parseJSON (String "public") = pure WebhookPublicEvent parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "pull_request") = pure WebhookPullRequestEvent @@ -130,6 +132,7 @@ instance ToJSON RepoWebhookEvent where toJSON (WebhookIssuesEvent) = String "issues" toJSON (WebhookMemberEvent) = String "member" toJSON (WebhookPageBuildEvent) = String "page_build" + toJSON (WebhookPingEvent) = String "ping" toJSON (WebhookPublicEvent) = String "public" toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" toJSON (WebhookPullRequestEvent) = String "pull_request" From abcfc2a608d2c30ce6f5eac47d348cee97c41a0b Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Sun, 11 Sep 2016 15:51:38 -0400 Subject: [PATCH 017/309] Resolve warning regarding parseUrlThrow The http-client library introduced a new name for `parseUrl` in version 0.4.30, `parseUrlThrow`, and deprecated the use of `parseUrl`. This causes a warning during compilation. Since we support http-client above `0.4.8.1`, I have added some additional CPP conditional compilation to import and use `parseUrl` for older versions of http-client, and to import and use `parseUrlThrow` in the newer versions. --- src/GitHub/Request.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a8b5bf34..840c08e0 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -66,8 +66,13 @@ import Data.List (find) import Network.HTTP.Client (CookieJar, HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, checkStatus, httpLbs, - method, newManager, parseUrl, requestBody, + method, newManager, requestBody, requestHeaders, setQueryString) +#if MIN_VERSION_http_client(0,4,30) +import Network.HTTP.Client (parseUrlThrow) +#else +import Network.HTTP.Client (parseUrl) +#endif import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) @@ -233,7 +238,11 @@ makeHttpRequest auth r = case r of return $ req' { requestHeaders = h <> requestHeaders req' } where parseUrl' :: MonadThrow m => Text -> m HTTP.Request +#if MIN_VERSION_http_client(0,4,30) + parseUrl' = parseUrlThrow . T.unpack +#else parseUrl' = parseUrl . T.unpack +#endif url :: Paths -> Text url paths = baseUrl <> "/" <> T.intercalate "/" paths From 27901e44f6d7a2093ed7acbf19af1b2b55570d3b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 12 Sep 2016 14:01:58 +0300 Subject: [PATCH 018/309] FetchCount instances, and reformat --- .stylish-haskell.yaml | 12 +- github.cabal | 1 - samples/Repos/DeployKeys/CreateDeployKey.hs | 2 - samples/Repos/DeployKeys/ListDeployKeys.hs | 2 +- samples/github-samples.cabal | 214 +++++++++--------- src/GitHub/Auth.hs | 1 + src/GitHub/Data.hs | 3 +- src/GitHub/Data/Activities.hs | 1 + src/GitHub/Data/Comments.hs | 1 + src/GitHub/Data/Content.hs | 1 + src/GitHub/Data/Definitions.hs | 1 + src/GitHub/Data/DeployKeys.hs | 1 + src/GitHub/Data/Gists.hs | 1 + src/GitHub/Data/GitData.hs | 1 + src/GitHub/Data/Id.hs | 1 + src/GitHub/Data/Issues.hs | 1 + src/GitHub/Data/Name.hs | 1 + src/GitHub/Data/PullRequests.hs | 1 + src/GitHub/Data/Repos.hs | 5 +- src/GitHub/Data/Request.hs | 3 + src/GitHub/Data/Search.hs | 1 + src/GitHub/Data/Teams.hs | 1 + src/GitHub/Data/URL.hs | 1 + src/GitHub/Data/Webhooks.hs | 2 + src/GitHub/Data/Webhooks/Validate.hs | 1 + src/GitHub/Endpoints/Activity/Starring.hs | 9 +- src/GitHub/Endpoints/Activity/Watching.hs | 3 +- src/GitHub/Endpoints/Gists.hs | 3 +- src/GitHub/Endpoints/Gists/Comments.hs | 3 +- src/GitHub/Endpoints/GitData/Blobs.hs | 3 +- src/GitHub/Endpoints/GitData/Commits.hs | 3 +- src/GitHub/Endpoints/GitData/References.hs | 3 +- src/GitHub/Endpoints/GitData/Trees.hs | 3 +- src/GitHub/Endpoints/Issues.hs | 1 + src/GitHub/Endpoints/Issues/Comments.hs | 3 +- src/GitHub/Endpoints/Issues/Events.hs | 3 +- src/GitHub/Endpoints/Issues/Labels.hs | 9 +- src/GitHub/Endpoints/Issues/Milestones.hs | 3 +- src/GitHub/Endpoints/Organizations.hs | 3 +- src/GitHub/Endpoints/Organizations/Members.hs | 3 +- src/GitHub/Endpoints/Organizations/Teams.hs | 3 +- src/GitHub/Endpoints/PullRequests.hs | 3 +- .../Endpoints/PullRequests/ReviewComments.hs | 3 +- src/GitHub/Endpoints/Repos.hs | 3 +- src/GitHub/Endpoints/Repos/Collaborators.hs | 3 +- src/GitHub/Endpoints/Repos/Comments.hs | 3 +- src/GitHub/Endpoints/Repos/Commits.hs | 5 +- src/GitHub/Endpoints/Repos/DeployKeys.hs | 3 +- src/GitHub/Endpoints/Repos/Forks.hs | 3 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 3 +- src/GitHub/Endpoints/Search.hs | 3 +- src/GitHub/Endpoints/Users.hs | 3 +- src/GitHub/Endpoints/Users/Followers.hs | 3 +- src/GitHub/Internal/Prelude.hs | 13 +- src/GitHub/Request.hs | 30 +-- stack-lts-5.yaml | 2 +- 56 files changed, 223 insertions(+), 178 deletions(-) diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 56d5acea..480cae6b 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -1,15 +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: - - DataKinds - - ExplicitForAll - - FlexibleContexts - MultiParamTypeClasses - - StandaloneDeriving + - FlexibleContexts + - ExplicitForAll + - DataKinds diff --git a/github.cabal b/github.cabal index 8e719b6f..c584f746 100644 --- a/github.cabal +++ b/github.cabal @@ -50,7 +50,6 @@ Library ghc-options: -Wall hs-source-dirs: src default-extensions: - NoImplicitPrelude DataKinds DeriveDataTypeable DeriveGeneric diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs index 20d4e02a..f95f3079 100644 --- a/samples/Repos/DeployKeys/CreateDeployKey.hs +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -1,11 +1,9 @@ {-# 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 -import Data.List import Data.Text (Text) main :: IO () diff --git a/samples/Repos/DeployKeys/ListDeployKeys.hs b/samples/Repos/DeployKeys/ListDeployKeys.hs index 650d1c9a..bde0b665 100644 --- a/samples/Repos/DeployKeys/ListDeployKeys.hs +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -4,7 +4,7 @@ module Main (main) where import qualified GitHub.Data.DeployKeys as DK import qualified GitHub.Endpoints.Repos.DeployKeys as DK import qualified GitHub.Auth as Auth -import Data.List +import Data.List (intercalate) import Data.Vector (toList) main :: IO () diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 58555afa..228575c9 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,4 +1,4 @@ --- This file has been generated from package.yaml by hpack version 0.9.0. +-- This file has been generated from package.yaml by hpack version 0.14.1. -- -- see: https://github.com/sol/hpack @@ -20,31 +20,10 @@ library Common default-language: Haskell2010 -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 - -executable github-list-team-current - main-is: ListTeamsCurrent.hs +executable github-add-team-membership-for + main-is: AddTeamMembershipFor.hs hs-source-dirs: - Teams + Teams/Memberships ghc-options: -Wall build-depends: base @@ -53,35 +32,12 @@ executable github-list-team-current , text , github-samples other-modules: - DeleteTeam - EditTeam - ListRepos - 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 + DeleteTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-show-deploy-key - main-is: ShowDeployKey.hs +executable github-create-deploy-key + main-is: CreateDeployKey.hs hs-source-dirs: Repos/DeployKeys ghc-options: -Wall @@ -92,9 +48,9 @@ executable github-show-deploy-key , text , github-samples other-modules: - CreateDeployKey DeleteDeployKey ListDeployKeys + ShowDeployKey default-language: Haskell2010 executable github-delete-deploy-key @@ -114,8 +70,8 @@ executable github-delete-deploy-key ShowDeployKey default-language: Haskell2010 -executable github-list-team-repos - main-is: ListRepos.hs +executable github-delete-team + main-is: DeleteTeam.hs hs-source-dirs: Teams ghc-options: -Wall @@ -126,8 +82,8 @@ executable github-list-team-repos , text , github-samples other-modules: - DeleteTeam EditTeam + ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor @@ -135,8 +91,24 @@ executable github-list-team-repos TeamInfoFor default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs +executable github-delete-team-membership-for + main-is: DeleteTeamMembershipFor.hs + hs-source-dirs: + Teams/Memberships + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + AddTeamMembershipFor + TeamMembershipInfoFor + default-language: Haskell2010 + +executable github-edit-team + main-is: EditTeam.hs hs-source-dirs: Teams ghc-options: -Wall @@ -147,7 +119,7 @@ executable github-delete-team , text , github-samples other-modules: - EditTeam + DeleteTeam ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor @@ -174,10 +146,10 @@ executable github-list-deploy-keys-for ShowDeployKey default-language: Haskell2010 -executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs +executable github-list-followers + main-is: ListFollowers.hs hs-source-dirs: - Teams/Memberships + Users/Followers ghc-options: -Wall build-depends: base @@ -186,32 +158,29 @@ executable github-delete-team-membership-for , text , github-samples other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor + Example + ListFollowing default-language: Haskell2010 -executable github-show-user-2 - main-is: ShowUser2.hs +executable github-list-followers-example + main-is: Example.hs hs-source-dirs: - Users + Users/Followers ghc-options: -Wall build-depends: base , base-compat , github , text - , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser + ListFollowers + ListFollowing default-language: Haskell2010 -executable github-show-user - main-is: ShowUser.hs +executable github-list-following + main-is: ListFollowing.hs hs-source-dirs: - Users + Users/Followers ghc-options: -Wall build-depends: base @@ -220,16 +189,14 @@ executable github-show-user , text , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 + Example + ListFollowers default-language: Haskell2010 -executable github-list-following - main-is: ListFollowing.hs +executable github-list-team-current + main-is: ListTeamsCurrent.hs hs-source-dirs: - Users/Followers + Teams ghc-options: -Wall build-depends: base @@ -238,27 +205,56 @@ executable github-list-following , text , github-samples other-modules: - Example - ListFollowers + DeleteTeam + EditTeam + ListRepos + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-list-followers-example - main-is: Example.hs +executable github-list-team-repos + main-is: ListRepos.hs hs-source-dirs: - Users/Followers + Teams ghc-options: -Wall build-depends: base , base-compat , github , text + , github-samples other-modules: - ListFollowers - ListFollowing + DeleteTeam + EditTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-create-deploy-key - main-is: CreateDeployKey.hs +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 + +executable github-show-deploy-key + main-is: ShowDeployKey.hs hs-source-dirs: Repos/DeployKeys ghc-options: -Wall @@ -269,15 +265,15 @@ executable github-create-deploy-key , text , github-samples other-modules: + CreateDeployKey DeleteDeployKey ListDeployKeys - ShowDeployKey default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs +executable github-show-user + main-is: ShowUser.hs hs-source-dirs: - Teams/Memberships + Users ghc-options: -Wall build-depends: base @@ -286,14 +282,16 @@ executable github-add-team-membership-for , text , github-samples other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser2 default-language: Haskell2010 -executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs +executable github-show-user-2 + main-is: ShowUser2.hs hs-source-dirs: - Teams/Memberships + Users ghc-options: -Wall build-depends: base @@ -302,14 +300,16 @@ executable github-team-membership-info-for , text , github-samples other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser default-language: Haskell2010 -executable github-list-followers - main-is: ListFollowers.hs +executable github-team-membership-info-for + main-is: TeamMembershipInfoFor.hs hs-source-dirs: - Users/Followers + Teams/Memberships ghc-options: -Wall build-depends: base @@ -318,8 +318,8 @@ executable github-list-followers , text , github-samples other-modules: - Example - ListFollowing + AddTeamMembershipFor + DeleteTeamMembershipFor default-language: Haskell2010 executable github-teaminfo-for diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 05ac6e30..c197fb4a 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -6,6 +6,7 @@ module GitHub.Auth where import GitHub.Internal.Prelude +import Prelude () import qualified Data.ByteString as BS diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index c63b7741..9700ff1b 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -49,6 +49,7 @@ module GitHub.Data ( ) where import GitHub.Internal.Prelude +import Prelude () import GitHub.Auth import GitHub.Data.Activities diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 4e62c32f..90943d36 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -7,6 +7,7 @@ module GitHub.Data.Activities where import GitHub.Data.Repos (Repo) import GitHub.Internal.Prelude +import Prelude () data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index c257d5e0..0343834a 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -9,6 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Comment = Comment { commentPosition :: !(Maybe Int) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 4347aab3..9c17b81e 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -7,6 +7,7 @@ module GitHub.Data.Content where import GitHub.Data.URL import GitHub.Internal.Prelude +import Prelude () data Content = ContentFile !ContentFileData diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 8b64b405..325cec76 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -6,6 +6,7 @@ module GitHub.Data.Definitions where import GitHub.Internal.Prelude +import Prelude () import Control.Monad (mfilter) import Data.Aeson.Types (Parser) diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index c93f0b6d..bca594c9 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -8,6 +8,7 @@ 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) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 60e380c2..4ed59f75 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -11,6 +11,7 @@ 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 diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 1bc582fc..c1761e9e 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -9,6 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Vector as V diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index e584c86e..e0dcfe27 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -10,6 +10,7 @@ module GitHub.Data.Id ( ) where import GitHub.Internal.Prelude +import Prelude () -- | Numeric identifier. newtype Id entity = Id Int diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 51a8d908..9457caa5 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -10,6 +10,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Issue = Issue { issueClosedAt :: Maybe UTCTime diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 43f48734..6f9fff53 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -10,6 +10,7 @@ module GitHub.Data.Name ( ) where import GitHub.Internal.Prelude +import Prelude () newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 812c866f..5ce84f7a 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -33,6 +33,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 9bcbf447..409b4b25 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | @@ -16,6 +16,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.HashMap.Strict as HM diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 7ccfbe37..604fcd82 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -102,6 +102,7 @@ instance Hashable (StatusMap a) where data FetchCount = FetchAtLeast !Word | FetchAll deriving (Eq, Ord, Read, Show, Generic, Typeable) + -- | This instance is there mostly for 'fromInteger'. instance Num FetchCount where fromInteger = FetchAtLeast . fromInteger @@ -117,6 +118,8 @@ instance Num FetchCount where negate = error "negate @FetchCount: not implemented" instance Hashable FetchCount +instance Binary FetchCount +instance NFData FetchCount where rnf = genericRnf ------------------------------------------------------------------------------ -- Github request diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index daaf0bc2..cd19da19 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -8,6 +8,7 @@ module GitHub.Data.Search where import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Vector as V diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 9ab433e9..2ee0b63c 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -15,6 +15,7 @@ import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Privacy = PrivacyClosed diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 5dea2a7e..9b29b673 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -9,6 +9,7 @@ module GitHub.Data.URL ( ) where import GitHub.Internal.Prelude +import Prelude () -- | Data representing URLs in responses. -- diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index aa8101c5..2e49e2e6 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -5,6 +5,8 @@ -- module GitHub.Data.Webhooks where +import Prelude () + import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index b8e8fe9b..00884a5d 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -10,6 +10,7 @@ module GitHub.Data.Webhooks.Validate ( ) where import GitHub.Internal.Prelude +import Prelude () import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) import Data.Byteable (constEqBytes, toBytes) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index d08645b2..1661305b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -19,8 +19,9 @@ module GitHub.Endpoints.Activity.Starring ( import GitHub.Auth import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The list of users that have starred the specified Github repo. -- @@ -40,7 +41,7 @@ stargazersForR user repo = -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user FetchAll + executeRequestMaybe auth $ reposStarredByR user FetchAll -- | List repositories being starred. -- See @@ -51,7 +52,7 @@ reposStarredByR user = -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = - executeRequest auth $ myStarredR FetchAll + executeRequest auth $ myStarredR FetchAll -- | All the repos starred by the authenticated user. -- See @@ -62,7 +63,7 @@ myStarredR = PagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) myStarredAcceptStar auth = - executeRequest auth $ myStarredAcceptStarR FetchAll + executeRequest auth $ myStarredAcceptStarR FetchAll -- | All the repos starred by the authenticated user. -- See diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 95ab457e..9e096053 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -15,10 +15,11 @@ module GitHub.Endpoints.Activity.Watching ( module GitHub.Data, ) where -import GitHub.Internal.Prelude import GitHub.Auth import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () -- | The list of users that are watching the specified Github repo. -- diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index ead659ec..6804a092 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Gists ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The list of all gists created by the user -- diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 1ca8a23c..60a27caa 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.Gists.Comments ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the comments on a Gist, given the Gist ID. -- diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index b9c3d5dd..33ab8437 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -13,8 +13,9 @@ module GitHub.Endpoints.GitData.Blobs ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | Query a blob by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 6bdd51d7..87bb6fac 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -12,8 +12,9 @@ module GitHub.Endpoints.GitData.Commits ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | A single commit, by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index a96e847d..7e0c6d57 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -20,8 +20,9 @@ module GitHub.Endpoints.GitData.References ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | A single reference by the ref name. -- diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index fecc3a27..29f27abe 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -16,8 +16,9 @@ module GitHub.Endpoints.GitData.Trees ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | A tree for a SHA1. -- diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 6ff8f763..8998d08d 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -25,6 +25,7 @@ module GitHub.Endpoints.Issues ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import Prelude () import qualified Data.Text as T import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index e12ec595..81a9b52c 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -18,9 +18,10 @@ module GitHub.Endpoints.Issues.Comments ( module GitHub.Data, ) where -import GitHub.Internal.Prelude import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () -- | A specific comment, by ID. -- diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 0581099e..bf108cee 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -19,8 +19,9 @@ module GitHub.Endpoints.Issues.Events ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All events that have happened on an issue. -- diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index b7e5192b..3e4829f7 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -35,15 +35,10 @@ module GitHub.Endpoints.Issues.Labels ( 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.Internal.Prelude import GitHub.Request +import Prelude () -- | All the labels available to use on any issue in the repo. -- diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 5e4869c6..65106975 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Issues.Milestones ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All milestones in the repo. -- diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 8bc3f746..098d39cc 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Organizations ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The public organizations for a user, given the user's login, with authorization -- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 333279db..f3588f56 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.Organizations.Members ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who are members of the specified organization, -- | with or without authentication. diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index ff25a8e9..8e8e9564 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -35,8 +35,9 @@ module GitHub.Endpoints.Organizations.Teams ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 46aae86b..5b79951d 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -29,8 +29,9 @@ module GitHub.Endpoints.PullRequests ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All open pull requests for the repo, by owner and repo name. -- diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 5c6528df..3fe77333 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.PullRequests.ReviewComments ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the comments on a pull request with the given ID. -- diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 6c5bb14e..3a588bf2 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -56,8 +56,9 @@ module GitHub.Endpoints.Repos ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 6753e9fa..36b47c89 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Repos.Collaborators ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who have collaborated on a repo. -- diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 30db12ab..6fd4dcc7 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -20,8 +20,9 @@ module GitHub.Endpoints.Repos.Comments ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the comments on a Github repo. -- diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index ff11f31d..b6ccf5be 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -23,9 +23,10 @@ module GitHub.Endpoints.Repos.Commits ( module GitHub.Data, ) where -import GitHub.Internal.Prelude import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () import qualified Data.ByteString as BS import qualified Data.Text as T diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 45dc0c3f..99db6ad2 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -22,8 +22,9 @@ module GitHub.Endpoints.Repos.DeployKeys ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | Querying deploy keys deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 76be374d..8b95c208 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -13,8 +13,9 @@ module GitHub.Endpoints.Repos.Forks ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the repos that are forked off the given repo. -- diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 5fa7b784..5a5d6810 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -33,8 +33,9 @@ module GitHub.Endpoints.Repos.Webhooks ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 41d62d74..86f125d3 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -19,8 +19,9 @@ module GitHub.Endpoints.Search( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 477a121a..71ebca84 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -16,8 +16,9 @@ module GitHub.Endpoints.Users ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The information for a single user, by login name. -- With authentification diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index 719a85d6..f112e424 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.Users.Followers ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users following the given user. -- diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 533fa1f2..49680f00 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -29,7 +29,7 @@ module GitHub.Internal.Prelude ( -- * Data.Maybe catMaybes, -- * Data.List - intercalate, + intercalate, toList, -- * Data.Time.ISO8601 formatISO8601, ) where @@ -37,13 +37,14 @@ module GitHub.Internal.Prelude ( import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), Object, ToJSON (..), Value (..), - encode, object, withObject, withText, (.!=), - (.:), (.:?), (.=)) +import Data.Aeson.Compat + (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, + withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) -import Data.Binary.Orphans () +import Data.Binary.Orphans () import Data.Data (Data, Typeable) +import Data.Foldable (toList) import Data.Hashable (Hashable (..)) import Data.HashMap.Strict (HashMap) import Data.List (intercalate) @@ -54,6 +55,6 @@ import Data.Text (Text, pack, unpack) import Data.Time (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import Data.Vector.Instances () +import Data.Vector.Instances () import GHC.Generics (Generic) import Prelude.Compat diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 840c08e0..6161bc8c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -50,6 +50,7 @@ module GitHub.Request ( ) where import GitHub.Internal.Prelude +import Prelude () #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except (MonadError (..)) @@ -63,23 +64,22 @@ import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Compat (eitherDecode) import Data.List (find) -import Network.HTTP.Client (CookieJar, HttpException (..), Manager, - RequestBody (..), Response (..), - applyBasicAuth, checkStatus, httpLbs, - method, newManager, requestBody, - requestHeaders, setQueryString) +import Network.HTTP.Client + (CookieJar, HttpException (..), Manager, RequestBody (..), + Response (..), applyBasicAuth, checkStatus, httpLbs, method, newManager, + requestBody, requestHeaders, setQueryString) #if MIN_VERSION_http_client(0,4,30) -import Network.HTTP.Client (parseUrlThrow) +import Network.HTTP.Client (parseUrlThrow) #else -import Network.HTTP.Client (parseUrl) +import Network.HTTP.Client (parseUrl) #endif 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.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 diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 127719a3..591b123f 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -1,4 +1,4 @@ -resolver: lts-5.17 +resolver: lts-5.18 packages: - '.' - samples/ From 30b679d26d36714af5ee760dd5e62409cb909784 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 10:29:13 +0300 Subject: [PATCH 019/309] Bump bounds --- github.cabal | 7 ++-- src/GitHub/Data/Repos.hs | 14 ++++++-- src/GitHub/Request.hs | 75 +++++++++++++++++++++++++--------------- stack-nightly.yaml | 7 ++-- 4 files changed, 67 insertions(+), 36 deletions(-) diff --git a/github.cabal b/github.cabal index c584f746..7fbe4539 100644 --- a/github.cabal +++ b/github.cabal @@ -117,8 +117,7 @@ Library -- 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, + aeson >=0.7.0.6 && <1.1, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, @@ -131,8 +130,8 @@ Library 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-client >=0.4.8.1 && <0.6, + http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, http-types >=0.8.6 && <0.10, iso8601-time >=0.1.4 && <0.2, diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 409b4b25..8e3c9343 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -8,7 +8,7 @@ -- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ --- orphan-ish instance. +-- orphan-ish instance for @aeson < 1@ module GitHub.Data.Repos where import GitHub.Data.Definitions @@ -19,10 +19,13 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.HashMap.Strict as HM - -#if UNSAFE +#if MIN_VERSION_aeson(1,0,0) +import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) +#else +#ifdef UNSAFE import Unsafe.Coerce (unsafeCoerce) #endif +#endif data Repo = Repo { repoSshUrl :: !(Maybe URL) @@ -237,6 +240,10 @@ instance FromJSON Language where instance ToJSON Language where toJSON = toJSON . getLanguage +#if MIN_VERSION_aeson(1,0,0) +instance FromJSONKey Language where + fromJSONKey = fromJSONKeyCoerce +#else instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where @@ -248,3 +255,4 @@ instance FromJSON a => FromJSON (HM.HashMap Language a) where mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a mapKey f = HM.fromList . map (first f) . HM.toList #endif +#endif diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 6161bc8c..7d192c6d 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -65,28 +65,27 @@ import Data.Aeson.Compat (eitherDecode) import Data.List (find) import Network.HTTP.Client - (CookieJar, HttpException (..), Manager, RequestBody (..), - Response (..), applyBasicAuth, checkStatus, httpLbs, method, newManager, - requestBody, requestHeaders, setQueryString) -#if MIN_VERSION_http_client(0,4,30) -import Network.HTTP.Client (parseUrlThrow) -#else -import Network.HTTP.Client (parseUrl) -#endif + (HttpException (..), Manager, RequestBody (..), Response (..), + applyBasicAuth, httpLbs, method, newManager, 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.HTTP.Types (Method, RequestHeaders, 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 +#if !MIN_VERSION_http_client(0,5,0) +import qualified Control.Exception as E +import Network.HTTP.Types (ResponseHeaders) +#endif + +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 qualified Network.HTTP.Client.Internal as HTTP import GitHub.Auth (Auth (..)) import GitHub.Data (Error (..)) @@ -239,9 +238,9 @@ makeHttpRequest auth r = case r of where parseUrl' :: MonadThrow m => Text -> m HTTP.Request #if MIN_VERSION_http_client(0,4,30) - parseUrl' = parseUrlThrow . T.unpack + parseUrl' = HTTP.parseRequest . T.unpack #else - parseUrl' = parseUrl . T.unpack + parseUrl' = HTTP.parseUrl . T.unpack #endif url :: Paths -> Text @@ -256,7 +255,11 @@ makeHttpRequest auth r = case r of setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request - setCheckStatus sm req = req { checkStatus = successOrMissing sm } +#if MIN_VERSION_http_client(0,5,0) + setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } +#else + setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } +#endif setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } @@ -278,15 +281,7 @@ makeHttpRequest auth r = case r of 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] + -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI @@ -357,5 +352,31 @@ performPagedRequest httpLbs' predicate initReq = do go (acc <> m) res' req' (_, _) -> return acc +------------------------------------------------------------------------------- +-- Internal +------------------------------------------------------------------------------- + +#if MIN_VERSION_http_client(0,5,0) +successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () +successOrMissing sm _req res + | check = pure () + | otherwise = do + chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024 + let res' = fmap (const ()) res + HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) + where + Status sci _ = HTTP.responseStatus res +#else +successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> HTTP.CookieJar -> Maybe E.SomeException +successOrMissing sm s@(Status sci _) hs cookiejar + | check = Nothing + | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar + where +#endif + check = case sm of + Nothing -> 200 <= sci && sci < 300 + Just StatusOnlyOk -> sci == 204 || sci == 404 + Just StatusMerge -> sci `elem` [204, 405, 409] + onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 81e4d4ff..14000e13 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,8 +1,11 @@ -resolver: nightly-2016-05-13 +resolver: nightly-2016-09-12 packages: - '.' - 'samples/' -extra-deps: [] +extra-deps: +- aeson-1.0.0.0 +- http-client-0.5.3.1 +- http-client-tls-0.3.1 flags: github: aeson-compat: true From 98347144be925de18751c5656226cb847e5be3df Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 15:49:06 +0300 Subject: [PATCH 020/309] Rework options, add currentUserIssuesR and organizationIssuesR --- CHANGELOG.md | 3 + github.cabal | 6 +- spec/GitHub/IssuesSpec.hs | 5 +- spec/GitHub/PullRequestsSpec.hs | 7 +- src/GitHub.hs | 5 +- src/GitHub/Data.hs | 4 + src/GitHub/Data/Issues.hs | 190 ++++------ src/GitHub/Data/Milestone.hs | 42 +++ src/GitHub/Data/Options.hs | 530 +++++++++++++++++++++++++++ src/GitHub/Data/PullRequests.hs | 123 +------ src/GitHub/Endpoints/Issues.hs | 47 +-- src/GitHub/Endpoints/PullRequests.hs | 14 +- src/GitHub/Endpoints/Repos.hs | 53 ++- src/GitHub/Request.hs | 3 +- 14 files changed, 730 insertions(+), 302 deletions(-) create mode 100644 src/GitHub/Data/Milestone.hs create mode 100644 src/GitHub/Data/Options.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 43121aa8..84527b7b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) +- Reworked PR and Issue filtering - GHC-8.0.1 support - Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` - Add `listTeamReposR` @@ -8,6 +9,8 @@ Changes for 0.15.0 - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` +- Add 'userIssuesR' +- Add 'organizationIssuesR' Changes for 0.14.1 diff --git a/github.cabal b/github.cabal index 7fbe4539..f5a99047 100644 --- a/github.cabal +++ b/github.cabal @@ -67,22 +67,24 @@ Library GitHub.Internal.Prelude GitHub.Auth GitHub.Data + GitHub.Data.Activities GitHub.Data.Comments GitHub.Data.Content GitHub.Data.Definitions + GitHub.Data.DeployKeys GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Issues GitHub.Data.Name + GitHub.Data.Milestone + GitHub.Data.Options GitHub.Data.PullRequests GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Search GitHub.Data.Teams - GitHub.Data.Activities GitHub.Data.URL - GitHub.Data.DeployKeys GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Starring diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index a550ac63..9eb41093 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -3,6 +3,9 @@ module GitHub.IssuesSpec where import qualified GitHub +import Prelude () +import Prelude.Compat + import Data.Either.Compat (isRight) import Data.Foldable (for_) import Data.String (fromString) @@ -25,7 +28,7 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo [] GitHub.FetchAll + GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll cs `shouldSatisfy` isRight where repos = diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 4bb93796..78d1ab1c 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,9 +3,11 @@ module GitHub.PullRequestsSpec where import qualified GitHub +import Prelude () +import Prelude.Compat + 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) @@ -34,5 +36,4 @@ spec = do , ("phadej", "github") , ("haskell", "cabal") ] - opts = GitHub.defaultPullRequestOptions - & GitHub.setPullRequestOptionsState GitHub.PullRequestStateClosed + opts = GitHub.stateClosed diff --git a/src/GitHub.hs b/src/GitHub.hs index 3c53cfb5..ce452a10 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -92,9 +92,8 @@ module GitHub ( -- * Issues -- | See -- - -- Missing endpoints: - -- - -- * List issues + currentUserIssuesR, + organizationIssuesR, issueR, issuesForRepoR, createIssueR, diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 9700ff1b..1a8e9c1b 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -39,6 +39,8 @@ module GitHub.Data ( module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, + module GitHub.Data.Milestone, + module GitHub.Data.Options, module GitHub.Data.PullRequests, module GitHub.Data.Repos, module GitHub.Data.Request, @@ -62,9 +64,11 @@ import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Issues import GitHub.Data.Name +import GitHub.Data.Milestone import GitHub.Data.PullRequests import GitHub.Data.Repos import GitHub.Data.Request +import GitHub.Data.Options import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.URL diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 9457caa5..eb05efc2 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -10,39 +10,42 @@ import GitHub.Data.Id (Id) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import GitHub.Data.Milestone (Milestone) import Prelude () -data Issue = Issue { - issueClosedAt :: Maybe UTCTime - ,issueUpdatedAt :: UTCTime - ,issueEventsUrl :: URL - ,issueHtmlUrl :: Maybe URL - ,issueClosedBy :: Maybe SimpleUser - ,issueLabels :: (Vector IssueLabel) - ,issueNumber :: Int - ,issueAssignee :: Maybe SimpleUser - ,issueUser :: SimpleUser - ,issueTitle :: Text - ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: URL - ,issueCreatedAt :: UTCTime - ,issueBody :: Maybe Text - ,issueState :: Text - ,issueId :: Id Issue - ,issueComments :: Int - ,issueMilestone :: Maybe Milestone -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Issue = Issue + { issueClosedAt :: Maybe UTCTime + , issueUpdatedAt :: UTCTime + , issueEventsUrl :: URL + , issueHtmlUrl :: Maybe URL + , issueClosedBy :: Maybe SimpleUser + , issueLabels :: (Vector IssueLabel) + , issueNumber :: Int + , issueAssignee :: Maybe SimpleUser + , issueUser :: SimpleUser + , issueTitle :: Text + , issuePullRequest :: Maybe PullRequestReference + , issueUrl :: URL + , 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 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 + , newIssueAssignee :: Maybe Text + , newIssueMilestone :: Maybe (Id Milestone) + , newIssueLabels :: Maybe (Vector Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue @@ -52,29 +55,13 @@ data EditIssue = EditIssue { , editIssueBody :: Maybe Text , editIssueAssignee :: Maybe Text , editIssueState :: Maybe Text -, editIssueMilestone :: Maybe Int +, editIssueMilestone :: Maybe (Id Milestone) , editIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue -data Milestone = Milestone { - milestoneCreator :: SimpleUser - ,milestoneDueOn :: Maybe UTCTime - ,milestoneOpenIssues :: Int - ,milestoneNumber :: Int - ,milestoneClosedIssues :: Int - ,milestoneDescription :: Maybe Text - ,milestoneTitle :: Text - ,milestoneUrl :: URL - ,milestoneCreatedAt :: UTCTime - ,milestoneState :: Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Milestone where rnf = genericRnf -instance Binary Milestone - data IssueLabel = IssueLabel { labelColor :: Text ,labelUrl :: URL @@ -135,76 +122,52 @@ data Event = Event { 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" + parseJSON = withObject "Event" $ \o -> Event + <$> o .: "actor" + <*> o .: "event" + <*> o .:? "commit_id" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "id" + <*> o .:? "issue" 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" + 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 = withObject "IssueLabel" $ \o -> IssueLabel + <$> o .: "color" + <*> o .: "url" + <*> o .: "name" 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 -> @@ -246,16 +209,3 @@ instance ToJSON EditIssue where , "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" diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs new file mode 100644 index 00000000..8141e2c8 --- /dev/null +++ b/src/GitHub/Data/Milestone.hs @@ -0,0 +1,42 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Milestone where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Milestone = Milestone + { milestoneCreator :: !SimpleUser + , milestoneDueOn :: !(Maybe UTCTime) + , milestoneOpenIssues :: !Int + , milestoneNumber :: !(Id Milestone) + , milestoneClosedIssues :: !Int + , milestoneDescription :: !(Maybe Text) + , milestoneTitle :: !Text + , milestoneUrl :: !URL + , milestoneCreatedAt :: !UTCTime + , milestoneState :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Milestone where rnf = genericRnf +instance Binary Milestone + +instance FromJSON Milestone where + parseJSON = withObject "Milestone" $ \o -> Milestone + <$> o .: "creator" + <*> o .: "due_on" + <*> o .: "open_issues" + <*> o .: "number" + <*> o .: "closed_issues" + <*> o .: "description" + <*> o .: "title" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "state" diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs new file mode 100644 index 00000000..f5885925 --- /dev/null +++ b/src/GitHub/Data/Options.hs @@ -0,0 +1,530 @@ +{-# LANGUAGE RecordWildCards #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +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, + optionsAssignedIssues, + optionsCreatedIssues, + optionsMentionedIssues, + optionsSubscribedIssues, + optionsAllIssues, + -- * Repo issues + IssueRepoMod, + issueRepoModToQueryString, + optionsAnyMilestone, + optionsNoMilestone, + optionsAnyAssignee, + optionsNoAssignee, + -- * Data + IssueState (..), + ) where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) +import GitHub.Internal.Prelude +import GitHub.Data.Milestone (Milestone) +import Prelude () + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +------------------------------------------------------------------------------- +-- Data +------------------------------------------------------------------------------- + +-- | Issue or PullRewuest state +data IssueState + = StateOpen + | StateClosed + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON IssueState where + toJSON StateOpen = String "open" + toJSON StateClosed = String "closed" + +instance FromJSON IssueState where + parseJSON (String "open") = pure StateOpen + parseJSON (String "closed") = pure StateClosed + parseJSON v = typeMismatch "IssueState" v + +instance NFData IssueState where rnf = genericRnf +instance Binary IssueState + +data SortDirection + = SortAscending + | SortDescending + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortDirection where rnf = genericRnf +instance Binary SortDirection + +-- PR + +data SortPR + = SortPRCreated + | SortPRUpdated + | SortPRPopularity + | SortPRLongRunning + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortPR where rnf = genericRnf +instance Binary SortPR + +-- Issue +data IssueFilter + = IssueFilterAssigned + | IssueFilterCreated + | IssueFilterMentioned + | IssueFilterSubscribed + | IssueFilterAll + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData IssueFilter where rnf = genericRnf +instance Binary IssueFilter + +data SortIssue + = SortIssueCreated + | SortIssueUpdated + | SortIssueComments + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortIssue where rnf = genericRnf +instance Binary SortIssue + +data FilterBy a + = FilterAny + | FilterNone + | FilterBy a + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +------------------------------------------------------------------------------- +-- Classes +------------------------------------------------------------------------------- + +class HasState mod where + state :: Maybe IssueState -> mod + +stateOpen :: HasState mod => mod +stateOpen = state (Just StateOpen) + +stateClosed :: HasState mod => mod +stateClosed = state (Just StateClosed) + +stateAll :: HasState mod => mod +stateAll = state Nothing + +instance HasState PullRequestMod where + state s = PRMod $ \opts -> + opts { pullRequestOptionsState = s } + +instance HasState IssueMod where + state s = IssueMod $ \opts -> + opts { issueOptionsState = s } + + +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 } + + +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 } + +------------------------------------------------------------------------------- +-- Pull Request +------------------------------------------------------------------------------- + +-- | See . +data PullRequestOptions = PullRequestOptions + { pullRequestOptionsState :: !(Maybe IssueState) + , pullRequestOptionsHead :: !(Maybe Text) + , pullRequestOptionsBase :: !(Maybe Text) + , pullRequestOptionsSort :: !SortPR + , pullRequestOptionsDirection :: !SortDirection + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultPullRequestOptions :: PullRequestOptions +defaultPullRequestOptions = PullRequestOptions + { pullRequestOptionsState = Just StateOpen + , pullRequestOptionsHead = Nothing + , pullRequestOptionsBase = Nothing + , pullRequestOptionsSort = SortPRCreated + , pullRequestOptionsDirection = SortDescending + } + +-- | See . +newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions) + +instance Semigroup PullRequestMod where + PRMod f <> PRMod g = PRMod (g . f) + +instance Monoid PullRequestMod where + mempty = PRMod id + mappend = (<>) + +toPullRequestOptions :: PullRequestMod -> PullRequestOptions +toPullRequestOptions (PRMod f) = f defaultPullRequestOptions + +prModToQueryString :: PullRequestMod -> QueryString +prModToQueryString = pullRequestOptionsToQueryString . toPullRequestOptions + +pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString +pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ mk "head" <$> head' + , mk "base" <$> base' + ] + where + mk k v = (k, Just v) + state' = case st of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case sort of + SortPRCreated -> "created" + SortPRUpdated -> "updated" + SortPRPopularity -> "popularity" + SortPRLongRunning -> "long-running" + direction' = case dir of + SortDescending -> "desc" + SortAscending -> "asc" + head' = fmap TE.encodeUtf8 head_ + base' = fmap TE.encodeUtf8 base + +------------------------------------------------------------------------------- +-- Pull request modifiers +------------------------------------------------------------------------------- + +optionsBase :: Text -> PullRequestMod +optionsBase x = PRMod $ \opts -> + opts { pullRequestOptionsBase = Just x } + +optionsNoBase :: PullRequestMod +optionsNoBase = PRMod $ \opts -> + opts { pullRequestOptionsBase = Nothing } + +optionsHead :: Text -> PullRequestMod +optionsHead x = PRMod $ \opts -> + opts { pullRequestOptionsHead = Just x } + +optionsNoHead :: PullRequestMod +optionsNoHead = PRMod $ \opts -> + opts { pullRequestOptionsHead = Nothing } + +sortByPopularity :: PullRequestMod +sortByPopularity = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRPopularity } + +sortByLongRunning :: PullRequestMod +sortByLongRunning = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRLongRunning } + +------------------------------------------------------------------------------- +-- Issues +------------------------------------------------------------------------------- + +-- | See . +data IssueOptions = IssueOptions + { issueOptionsFilter :: !IssueFilter + , issueOptionsState :: !(Maybe IssueState) + , issueOptionsLabels :: ![Text] -- TODO: change to newtype + , issueOptionsSort :: !SortIssue + , issueOptionsDirection :: !SortDirection + , issueOptionsSince :: !(Maybe UTCTime) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultIssueOptions :: IssueOptions +defaultIssueOptions = IssueOptions + { issueOptionsFilter = IssueFilterAssigned + , issueOptionsState = Just StateOpen + , issueOptionsLabels = [] + , issueOptionsSort = SortIssueCreated + , issueOptionsDirection = SortDescending + , issueOptionsSince = Nothing + } + +-- | See . +newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) + +instance Semigroup IssueMod where + IssueMod f <> IssueMod g = IssueMod (g . f) + +instance Monoid IssueMod where + mempty = IssueMod id + mappend = (<>) + +toIssueOptions :: IssueMod -> IssueOptions +toIssueOptions (IssueMod f) = f defaultIssueOptions + +issueModToQueryString :: IssueMod -> QueryString +issueModToQueryString = issueOptionsToQueryString . toIssueOptions + +issueOptionsToQueryString :: IssueOptions -> QueryString +issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + , mk "filter" filt' + ] ++ catMaybes + [ mk "labels" <$> labels' + , mk "since" <$> since' + ] + where + mk k v = (k, Just v) + filt' = case filt of + IssueFilterAssigned -> "assigned" + IssueFilterCreated -> "created" + IssueFilterMentioned -> "mentioned" + IssueFilterSubscribed -> "subscribed" + IssueFilterAll -> "all" + state' = case st of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case sort of + SortIssueCreated -> "created" + SortIssueUpdated -> "updated" + SortIssueComments -> "comments" + direction' = case dir of + SortDescending -> "desc" + SortAscending -> "asc" + + since' = fmap (TE.encodeUtf8 . T.pack . show) since + labels' = TE.encodeUtf8 . T.intercalate "," <$> 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 :: [Text] -> mod + +instance HasLabels IssueMod where + optionsLabels lbls = IssueMod $ \opts -> + opts { issueOptionsLabels = lbls } + +instance HasLabels IssueRepoMod where + optionsLabels lbls = IssueRepoMod $ \opts -> + opts { issueRepoOptionsLabels = lbls } + + +class HasSince mod where + optionsSince :: UTCTime -> mod + optionsSinceAll :: mod + +instance HasSince IssueMod where + optionsSince since = IssueMod $ \opts -> + opts { issueOptionsSince = Just since } + optionsSinceAll = IssueMod $ \opts -> + opts { issueOptionsSince = Nothing } + +instance HasSince IssueRepoMod where + optionsSince since = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSince = Just since } + optionsSinceAll = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSince = Nothing } + +------------------------------------------------------------------------------- +-- Only issues modifiers +------------------------------------------------------------------------------- + +optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, + optionsSubscribedIssues, optionsAllIssues :: IssueMod +optionsAssignedIssues = issueFilter IssueFilterAssigned +optionsCreatedIssues = issueFilter IssueFilterCreated +optionsMentionedIssues = issueFilter IssueFilterMentioned +optionsSubscribedIssues = issueFilter IssueFilterSubscribed +optionsAllIssues = issueFilter IssueFilterAll + +issueFilter :: IssueFilter -> IssueMod +issueFilter f = IssueMod $ \opts -> + opts { issueOptionsFilter = f } + +------------------------------------------------------------------------------- +-- Issues repo +------------------------------------------------------------------------------- + +data IssueRepoOptions = IssueRepoOptions + { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) + , issueRepoOptionsState :: !(Maybe IssueState) + , issueRepoOptionsAssignee :: !(FilterBy (Name User)) + , issueRepoOptionsCreator :: !(Maybe (Name User)) + , issueRepoOptionsMentioned :: !(Maybe (Name User)) + , issueRepoOptionsLabels :: ![Text] + , issueRepoOptionsSort :: !SortIssue + , issueRepoOptionsDirection :: !SortDirection + , issueRepoOptionsSince :: !(Maybe UTCTime) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultIssueRepoOptions :: IssueRepoOptions +defaultIssueRepoOptions = IssueRepoOptions + { issueRepoOptionsMilestone = FilterAny + , issueRepoOptionsState = (Just StateOpen) + , issueRepoOptionsAssignee = FilterAny + , 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 "milestone" milestone' + , mk "assignee" assignee' + , mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ 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 -> "*" + FilterNone -> "none" + FilterBy x' -> TE.encodeUtf8 (f x') + + 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 "," <$> nullToNothing issueRepoOptionsLabels + creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator + mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned + +------------------------------------------------------------------------------- +-- Issues repo modifiers +------------------------------------------------------------------------------- + +optionsAnyMilestone :: IssueRepoMod +optionsAnyMilestone = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterAny } + +optionsNoMilestone :: IssueRepoMod +optionsNoMilestone = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterNone } + +optionsAnyAssignee :: IssueRepoMod +optionsAnyAssignee = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterAny } + +optionsNoAssignee :: IssueRepoMod +optionsNoAssignee = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterNone } diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 5ce84f7a..56445cdf 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -13,36 +13,22 @@ module GitHub.Data.PullRequests ( PullRequestEvent(..), PullRequestEventType(..), PullRequestReference(..), - PullRequestState(..), - PullRequestSort(..), - PullRequestSortDirection(..), - -- * Pull Request listing options - PullRequestOptions, - defaultPullRequestOptions, - pullRequestOptionsToQueryString, - setPullRequestOptionsState, - setPullRequestOptionsStateAll, - setPullRequestOptionsSort, - setPullRequestOptionsDirection, - setPullRequestOptionsHead, - setPullRequestOptionsBase, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) +import GitHub.Data.Options (IssueState (..)) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -import qualified Data.Text.Encoding as TE - data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) , simplePullRequestCreatedAt :: !UTCTime , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL - , simplePullRequestState :: !PullRequestState + , simpleIssueState :: !IssueState , simplePullRequestNumber :: !Int , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime @@ -64,7 +50,7 @@ data PullRequest = PullRequest , pullRequestCreatedAt :: !UTCTime , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL - , pullRequestState :: !PullRequestState + , pullRequestState :: !IssueState , pullRequestNumber :: !Int , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime @@ -95,7 +81,7 @@ instance Binary PullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) - , editPullRequestState :: !(Maybe PullRequestState) + , editPullRequestState :: !(Maybe IssueState) } deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf @@ -175,98 +161,6 @@ data PullRequestReference = PullRequestReference instance NFData PullRequestReference where rnf = genericRnf 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 @@ -292,15 +186,6 @@ 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 ] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 8998d08d..b2b7555c 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -6,13 +6,14 @@ -- -- The issues API as described on . module GitHub.Endpoints.Issues ( + currentUserIssuesR, + organizationIssuesR, issue, issue', issueR, issuesForRepo, issuesForRepo', issuesForRepoR, - IssueLimitation(..), createIssue, createIssueR, newIssue, @@ -27,8 +28,15 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE +-- | See . +currentUserIssuesR :: IssueMod -> FetchCount -> Request k (Vector Issue) +currentUserIssuesR opts = + PagedQuery ["user", "issues"] (issueModToQueryString opts) + +-- | See . +organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) +organizationIssuesR org opts = + PagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' @@ -52,42 +60,27 @@ 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. +-- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) -issuesForRepo' auth user reqRepoName issueLimitations = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations FetchAll +issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) +issuesForRepo' auth user reqRepoName opts = + executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll -- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. +-- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo :: Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) +issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See -issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> FetchCount -> Request k (Vector Issue) -issuesForRepoR user reqRepoName issueLimitations = +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 . TE.encodeUtf8 . T.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 . TE.encodeUtf8 . T.pack $ u) - convert (Mentions u) = ("mentioned", Just . TE.encodeUtf8 . T.pack $ u) - convert (Labels l) = ("labels", Just . TE.encodeUtf8 . T.pack $ intercalate "," l) - convert Ascending = ("direction", Just "asc") - convert Descending = ("direction", Just "desc") - convert (PerPage n) = ("per_page", Just . TE.encodeUtf8 . T.pack $ show n) - convert (Since t) = ("since", Just . TE.encodeUtf8 . T.pack $ formatISO8601 t) + qs = issueRepoModToQueryString opts -- Creating new issues. diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 5b79951d..04c2247f 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -38,17 +38,19 @@ import Prelude () -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions FetchAll + executeRequest' $ pullRequestsForR user repo mempty FetchAll -- | List pull requests. -- See -pullRequestsForR :: Name Owner -> Name Repo - -> PullRequestOptions -- ^ State - -> FetchCount - -> Request k (Vector SimplePullRequest) +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. diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 3a588bf2..d5be2120 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -76,7 +76,7 @@ currentUserRepos auth publicity = -- | List your repositories. -- See -currentUserReposR :: RepoPublicity -> FetchCount -> Request k(Vector Repo) +currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = PagedQuery ["user", "repos"] qs where @@ -93,7 +93,11 @@ userRepos = userRepos' Nothing -- With authentication. -- -- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All -userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) +userRepos' + :: Maybe Auth + -> Name Owner + -> RepoPublicity + -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = executeRequestMaybe auth $ userReposR user publicity FetchAll @@ -115,13 +119,21 @@ organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- With authentication. -- -- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All -organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) +organizationRepos' + :: Maybe Auth + -> Name Organization + -> RepoPublicity + -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = executeRequestMaybe auth $ organizationReposR org publicity FetchAll -- | List organization repositories. -- See -organizationReposR :: Name Organization -> RepoPublicity -> FetchCount -> Request k (Vector Repo) +organizationReposR + :: Name Organization + -> RepoPublicity + -> FetchCount + -> Request k (Vector Repo) organizationReposR org publicity = PagedQuery ["orgs", toPathPart org, "repos"] qs where @@ -176,11 +188,12 @@ createOrganizationRepoR org 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 + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> EditRepo + -> IO (Either Error Repo) editRepo auth user repo body = executeRequest auth $ editRepoR user repo body @@ -210,11 +223,12 @@ contributors' auth user repo = -- | List contributors. -- See -contributorsR :: Name Owner - -> Name Repo - -> Bool -- ^ Include anonymous - -> FetchCount - -> 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 where @@ -315,11 +329,12 @@ contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> contentsFor' auth user repo path ref = executeRequestMaybe auth $ contentsForR user repo path ref -contentsForR :: Name Owner - -> Name Repo - -> Text -- ^ file or directory - -> Maybe Text -- ^ Git commit - -> Request k Content +contentsForR + :: 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 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 7d192c6d..a652525a 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -68,7 +68,6 @@ import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, httpLbs, method, newManager, 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 @@ -346,7 +345,7 @@ performPagedRequest httpLbs' predicate initReq = do 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' go (acc <> m) res' req' From b933c950c46f4a2c4c2bfb8df4f4ed6a2ceae946 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 16:18:40 +0300 Subject: [PATCH 021/309] Add labels newtype (Name IssueLabel) --- src/GitHub/Data/Activities.hs | 9 +- src/GitHub/Data/Comments.hs | 41 +++--- src/GitHub/Data/Definitions.hs | 20 +++ src/GitHub/Data/DeployKeys.hs | 65 ++++----- src/GitHub/Data/Issues.hs | 235 ++++++++++++++++----------------- src/GitHub/Data/Options.hs | 14 +- 6 files changed, 200 insertions(+), 184 deletions(-) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 90943d36..67896cb9 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -9,10 +9,11 @@ import GitHub.Data.Repos (Repo) import GitHub.Internal.Prelude import Prelude () -data RepoStarred = RepoStarred { - repoStarredStarredAt :: !UTCTime - ,repoStarredRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoStarred = RepoStarred + { repoStarredStarredAt :: !UTCTime + , repoStarredRepo :: !Repo + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoStarred where rnf = genericRnf instance Binary RepoStarred diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 0343834a..9c966e7a 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -11,19 +11,20 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data Comment = Comment { - commentPosition :: !(Maybe Int) - ,commentLine :: !(Maybe Int) - ,commentBody :: !Text - ,commentCommitId :: !(Maybe Text) - ,commentUpdatedAt :: !UTCTime - ,commentHtmlUrl :: !(Maybe URL) - ,commentUrl :: !URL - ,commentCreatedAt :: !(Maybe UTCTime) - ,commentPath :: !(Maybe Text) - ,commentUser :: !SimpleUser - ,commentId :: !(Id Comment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Comment = Comment + { commentPosition :: !(Maybe Int) + , commentLine :: !(Maybe Int) + , commentBody :: !Text + , commentCommitId :: !(Maybe Text) + , commentUpdatedAt :: !UTCTime + , commentHtmlUrl :: !(Maybe URL) + , commentUrl :: !URL + , commentCreatedAt :: !(Maybe UTCTime) + , commentPath :: !(Maybe Text) + , commentUser :: !SimpleUser + , commentId :: !(Id Comment) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment where rnf = genericRnf instance Binary Comment @@ -42,9 +43,10 @@ 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, Typeable, Eq, Ord, Generic) instance NFData NewComment where rnf = genericRnf instance Binary NewComment @@ -52,9 +54,10 @@ 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, Typeable, Eq, Ord, Generic) instance NFData EditComment where rnf = genericRnf instance Binary EditComment diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 325cec76..c4a5c95d 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -238,3 +238,23 @@ type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int + +------------------------------------------------------------------------------- +-- IssueLabel +------------------------------------------------------------------------------- + +data IssueLabel = IssueLabel + { labelColor :: !Text + , labelUrl :: !URL + , labelName :: !(Name IssueLabel) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData IssueLabel where rnf = genericRnf +instance Binary IssueLabel + +instance FromJSON IssueLabel where + parseJSON = withObject "IssueLabel" $ \o -> IssueLabel + <$> o .: "color" + <*> o .: "url" + <*> o .: "name" diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index bca594c9..7dd1bb1d 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -10,42 +10,43 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data RepoDeployKey = RepoDeployKey { - repoDeployKeyId :: !(Id RepoDeployKey) - ,repoDeployKeyKey :: !Text - ,repoDeployKeyUrl :: !URL - ,repoDeployKeyTitle :: !Text - ,repoDeployKeyVerified :: !Bool - ,repoDeployKeyCreatedAt :: !UTCTime - ,repoDeployKeyReadOnly :: !Bool -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoDeployKey = RepoDeployKey + { repoDeployKeyId :: !(Id RepoDeployKey) + , repoDeployKeyKey :: !Text + , repoDeployKeyUrl :: !URL + , repoDeployKeyTitle :: !Text + , repoDeployKeyVerified :: !Bool + , repoDeployKeyCreatedAt :: !UTCTime + , repoDeployKeyReadOnly :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON RepoDeployKey where - parseJSON = withObject "RepoDeployKey" $ \o -> - RepoDeployKey <$> o .: "id" - <*> o .: "key" - <*> o .: "url" - <*> o .: "title" - <*> o .: "verified" - <*> o .: "created_at" - <*> o .: "read_only" + parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey + <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" -data NewRepoDeployKey = NewRepoDeployKey { - newRepoDeployKeyKey :: !Text - ,newRepoDeployKeyTitle :: !Text - ,newRepoDeployKeyReadOnly :: !Bool -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewRepoDeployKey = NewRepoDeployKey + { newRepoDeployKeyKey :: !Text + , newRepoDeployKeyTitle :: !Text + , newRepoDeployKeyReadOnly :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where - toJSON (NewRepoDeployKey key title readOnly) = - object [ - "key" .= key - , "title" .= title - , "read_only" .= readOnly - ] + 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" + parseJSON = withObject "RepoDeployKey" $ \o -> NewRepoDeployKey + <$> o .: "key" + <*> o .: "title" + <*> o .: "read_only" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index eb05efc2..fb70c626 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -7,117 +7,112 @@ module GitHub.Data.Issues where import GitHub.Data.Definitions import GitHub.Data.Id (Id) +import GitHub.Data.Milestone (Milestone) +import GitHub.Data.Name (Name) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude -import GitHub.Data.Milestone (Milestone) import Prelude () data Issue = Issue - { issueClosedAt :: Maybe UTCTime - , issueUpdatedAt :: UTCTime - , issueEventsUrl :: URL - , issueHtmlUrl :: Maybe URL - , issueClosedBy :: Maybe SimpleUser - , issueLabels :: (Vector IssueLabel) - , issueNumber :: Int - , issueAssignee :: Maybe SimpleUser - , issueUser :: SimpleUser - , issueTitle :: Text - , issuePullRequest :: Maybe PullRequestReference - , issueUrl :: URL - , issueCreatedAt :: UTCTime - , issueBody :: Maybe Text - , issueState :: Text - , issueId :: Id Issue - , issueComments :: Int - , issueMilestone :: Maybe Milestone + { issueClosedAt :: !(Maybe UTCTime) + , issueUpdatedAt :: !UTCTime + , issueEventsUrl :: !URL + , issueHtmlUrl :: !(Maybe URL) + , issueClosedBy :: !(Maybe SimpleUser) + , issueLabels :: (Vector (Name IssueLabel)) + , issueNumber :: !Int + , issueAssignee :: !(Maybe SimpleUser) + , issueUser :: !SimpleUser + , issueTitle :: !Text + , issuePullRequest :: !(Maybe PullRequestReference) + , issueUrl :: !URL + , issueCreatedAt :: !UTCTime + , issueBody :: !(Maybe Text) + , issueState :: !Text + , issueId :: !(Id Issue) + , issueComments :: !Int + , issueMilestone :: !(Maybe Milestone) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf instance Binary Issue data NewIssue = NewIssue - { newIssueTitle :: Text - , newIssueBody :: Maybe Text - , newIssueAssignee :: Maybe Text - , newIssueMilestone :: Maybe (Id Milestone) - , newIssueLabels :: Maybe (Vector Text) + { newIssueTitle :: !Text + , newIssueBody :: !(Maybe Text) + , newIssueAssignee :: !(Maybe Text) + , newIssueMilestone :: !(Maybe (Id Milestone)) + , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue -data EditIssue = EditIssue { - editIssueTitle :: Maybe Text -, editIssueBody :: Maybe Text -, editIssueAssignee :: Maybe Text -, editIssueState :: Maybe Text -, editIssueMilestone :: Maybe (Id Milestone) -, editIssueLabels :: Maybe (Vector Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditIssue = EditIssue + { editIssueTitle :: !(Maybe Text) + , editIssueBody :: !(Maybe Text) + , editIssueAssignee :: !(Maybe Text) + , editIssueState :: !(Maybe Text) + , editIssueMilestone :: !(Maybe (Id Milestone)) + , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue -data IssueLabel = IssueLabel { - labelColor :: Text - ,labelUrl :: URL - ,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 :: URL - ,issueCommentHtmlUrl :: URL - ,issueCommentCreatedAt :: UTCTime - ,issueCommentBody :: Text - ,issueCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data IssueComment = IssueComment + { issueCommentUpdatedAt :: !UTCTime + , issueCommentUser :: !SimpleUser + , issueCommentUrl :: !URL + , issueCommentHtmlUrl :: !URL + , issueCommentCreatedAt :: !UTCTime + , issueCommentBody :: !Text + , issueCommentId :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment -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) +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, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event -data Event = Event { - eventActor :: !SimpleUser - ,eventType :: !EventType - ,eventCommitId :: !(Maybe Text) - ,eventUrl :: !URL - ,eventCreatedAt :: !UTCTime - ,eventId :: !Int - ,eventIssue :: !(Maybe Issue) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Event = Event + { eventActor :: !SimpleUser + , eventType :: !EventType + , eventCommitId :: !(Maybe Text) + , eventUrl :: !URL + , eventCreatedAt :: !UTCTime + , eventId :: !Int + , eventIssue :: !(Maybe Issue) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf instance Binary Event @@ -153,12 +148,6 @@ instance FromJSON EventType where 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" - instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment <$> o .: "updated_at" @@ -170,42 +159,44 @@ instance FromJSON IssueComment where <*> 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 .:? "assignee" + <*> o .: "user" + <*> o .: "title" + <*> o .:? "pull_request" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "state" + <*> o .: "id" + <*> o .: "comments" + <*> o .:? "milestone" instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = - object - [ "title" .= t - , "body" .= b - , "assignee" .= a - , "milestone" .= m - , "labels" .= ls ] + toJSON (NewIssue t b a m ls) = object + [ "title" .= t + , "body" .= b + , "assignee" .= a + , "milestone" .= m + , "labels" .= ls + ] instance ToJSON EditIssue where - toJSON (EditIssue t b a s m ls) = - object $ filter notNull $ [ "title" .= t - , "body" .= b - , "assignee" .= a - , "state" .= s - , "milestone" .= m - , "labels" .= ls ] - where notNull (_, Null) = False - notNull (_, _) = True + 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 diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index f5885925..39900719 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -290,7 +290,7 @@ sortByLongRunning = PRMod $ \opts -> data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) - , issueOptionsLabels :: ![Text] -- TODO: change to newtype + , issueOptionsLabels :: ![Name IssueLabel] -- TODO: change to newtype , issueOptionsSort :: !SortIssue , issueOptionsDirection :: !SortDirection , issueOptionsSince :: !(Maybe UTCTime) @@ -355,7 +355,7 @@ issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = SortAscending -> "asc" since' = fmap (TE.encodeUtf8 . T.pack . show) since - labels' = TE.encodeUtf8 . T.intercalate "," <$> nullToNothing labels + labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing labels nullToNothing :: Foldable f => f a -> Maybe (f a) nullToNothing xs @@ -379,15 +379,15 @@ instance HasComments IssueRepoMod where class HasLabels mod where - optionsLabels :: [Text] -> mod + optionsLabels :: Foldable f => f (Name IssueLabel) -> mod instance HasLabels IssueMod where optionsLabels lbls = IssueMod $ \opts -> - opts { issueOptionsLabels = lbls } + opts { issueOptionsLabels = toList lbls } instance HasLabels IssueRepoMod where optionsLabels lbls = IssueRepoMod $ \opts -> - opts { issueRepoOptionsLabels = lbls } + opts { issueRepoOptionsLabels = toList lbls } class HasSince mod where @@ -432,7 +432,7 @@ data IssueRepoOptions = IssueRepoOptions , issueRepoOptionsAssignee :: !(FilterBy (Name User)) , issueRepoOptionsCreator :: !(Maybe (Name User)) , issueRepoOptionsMentioned :: !(Maybe (Name User)) - , issueRepoOptionsLabels :: ![Text] + , issueRepoOptionsLabels :: ![Name IssueLabel] , issueRepoOptionsSort :: !SortIssue , issueRepoOptionsDirection :: !SortDirection , issueRepoOptionsSince :: !(Maybe UTCTime) @@ -505,7 +505,7 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = SortAscending -> "asc" since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince - labels' = TE.encodeUtf8 . T.intercalate "," <$> nullToNothing issueRepoOptionsLabels + labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing issueRepoOptionsLabels creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned From 535fa7eccb5de828e6168037537298593b97927c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 16:41:31 +0300 Subject: [PATCH 022/309] reformat and some newtypes --- spec/GitHub/SearchSpec.hs | 6 +- src/GitHub/Data/Gists.hs | 116 +++++----- src/GitHub/Data/GitData.hs | 398 +++++++++++++++++--------------- src/GitHub/Data/Issues.hs | 9 +- src/GitHub/Data/Options.hs | 25 +- src/GitHub/Data/PullRequests.hs | 16 +- src/GitHub/Data/Search.hs | 52 +++-- src/GitHub/Data/Webhooks.hs | 248 ++++++++++---------- 8 files changed, 459 insertions(+), 411 deletions(-) diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 11f12ee6..97e311d4 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -14,7 +14,7 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), mkId) +import GitHub.Data (Auth (..), Issue (..), mkId, IssueState (..)) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b @@ -42,13 +42,13 @@ spec = do issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 issueNumber issue1 `shouldBe` 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 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" diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 4ed59f75..3e1fbe79 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -13,77 +13,79 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data Gist = Gist { - gistUser :: !SimpleUser - ,gistGitPushUrl :: !URL - ,gistUrl :: !URL - ,gistDescription :: !(Maybe Text) - ,gistCreatedAt :: !UTCTime - ,gistPublic :: !Bool - ,gistComments :: !Int - ,gistUpdatedAt :: !UTCTime - ,gistHtmlUrl :: !URL - ,gistId :: !(Name Gist) - ,gistFiles :: !(HashMap Text GistFile) - ,gistGitPullUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Generic) +data Gist = Gist + { gistUser :: !SimpleUser + , gistGitPushUrl :: !URL + , gistUrl :: !URL + , gistDescription :: !(Maybe Text) + , gistCreatedAt :: !UTCTime + , gistPublic :: !Bool + , gistComments :: !Int + , gistUpdatedAt :: !UTCTime + , gistHtmlUrl :: !URL + , gistId :: !(Name Gist) + , gistFiles :: !(HashMap Text GistFile) + , gistGitPullUrl :: !URL + } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf instance Binary Gist instance FromJSON Gist where - parseJSON = withObject "Gist" $ \o -> - Gist <$> o .: "owner" - <*> o .: "git_push_url" - <*> o .: "url" - <*> o .:? "description" - <*> o .: "created_at" - <*> o .: "public" - <*> o .: "comments" - <*> o .: "updated_at" - <*> o .: "html_url" - <*> o .: "id" - <*> o .: "files" - <*> o .: "git_push_url" + parseJSON = withObject "Gist" $ \o -> Gist + <$> o .: "owner" + <*> o .: "git_push_url" + <*> o .: "url" + <*> o .:? "description" + <*> o .: "created_at" + <*> o .: "public" + <*> o .: "comments" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "id" + <*> o .: "files" + <*> o .: "git_push_url" -data GistFile = GistFile { - gistFileType :: !Text - ,gistFileRawUrl :: !URL - ,gistFileSize :: !Int - ,gistFileLanguage :: !(Maybe Language) - ,gistFileFilename :: !Text - ,gistFileContent :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Generic) +data GistFile = GistFile + { gistFileType :: !Text + , gistFileRawUrl :: !URL + , gistFileSize :: !Int + , gistFileLanguage :: !(Maybe Language) + , gistFileFilename :: !Text + , gistFileContent :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Generic) instance NFData GistFile where rnf = genericRnf instance Binary GistFile instance FromJSON GistFile where - parseJSON = withObject "GistFile" $ \o -> - GistFile <$> o .: "type" - <*> o .: "raw_url" - <*> o .: "size" - <*> o .:? "language" - <*> o .: "filename" - <*> o .:? "content" + parseJSON = withObject "GistFile" $ \o -> GistFile + <$> o .: "type" + <*> o .: "raw_url" + <*> o .: "size" + <*> o .:? "language" + <*> o .: "filename" + <*> o .:? "content" -data GistComment = GistComment { - gistCommentUser :: !SimpleUser - ,gistCommentUrl :: !URL - ,gistCommentCreatedAt :: !UTCTime - ,gistCommentBody :: !Text - ,gistCommentUpdatedAt :: !UTCTime - ,gistCommentId :: !(Id GistComment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GistComment = GistComment + { gistCommentUser :: !SimpleUser + , gistCommentUrl :: !URL + , gistCommentCreatedAt :: !UTCTime + , gistCommentBody :: !Text + , gistCommentUpdatedAt :: !UTCTime + , gistCommentId :: !(Id GistComment) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment where rnf = genericRnf instance Binary GistComment instance FromJSON GistComment where - parseJSON = withObject "GistComment" $ \o -> - GistComment <$> o .: "user" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "updated_at" - <*> o .: "id" + parseJSON = withObject "GistComment" $ \o -> GistComment + <$> o .: "user" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "updated_at" + <*> o .: "id" diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index c1761e9e..5df5b953 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -14,171 +14,187 @@ 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) +data CommitQueryOption + = CommitQuerySha !Text + | CommitQueryPath !Text + | CommitQueryAuthor !Text + | CommitQuerySince !UTCTime + | CommitQueryUntil !UTCTime + deriving (Show, Eq, Ord, Generic, Typeable, Data) + +data Stats = Stats + { statsAdditions :: !Int + , statsTotal :: !Int + , statsDeletions :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats where rnf = genericRnf instance Binary Stats -data Commit = Commit { - commitSha :: !(Name Commit) - ,commitParents :: !(Vector Tree) - ,commitUrl :: !URL - ,commitGitCommit :: !GitCommit - ,commitCommitter :: !(Maybe SimpleUser) - ,commitAuthor :: !(Maybe SimpleUser) - ,commitFiles :: !(Vector File) - ,commitStats :: !(Maybe Stats) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Commit = Commit + { commitSha :: !(Name Commit) + , commitParents :: !(Vector Tree) + , commitUrl :: !URL + , commitGitCommit :: !GitCommit + , commitCommitter :: !(Maybe SimpleUser) + , commitAuthor :: !(Maybe SimpleUser) + , commitFiles :: !(Vector File) + , commitStats :: !(Maybe Stats) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit where rnf = genericRnf instance Binary Commit -data Tree = Tree { - treeSha :: !(Name Tree) - ,treeUrl :: !URL - ,treeGitTrees :: !(Vector GitTree) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Tree = Tree + { treeSha :: !(Name Tree) + , treeUrl :: !URL + , treeGitTrees :: !(Vector GitTree) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree where rnf = genericRnf instance Binary Tree -data GitTree = GitTree { - gitTreeType :: !Text - ,gitTreeSha :: !(Name GitTree) - -- Can be empty for submodule - ,gitTreeUrl :: !(Maybe URL) - ,gitTreeSize :: !(Maybe Int) - ,gitTreePath :: !Text - ,gitTreeMode :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitTree = GitTree + { gitTreeType :: !Text + , gitTreeSha :: !(Name GitTree) + -- Can be empty for submodule + , gitTreeUrl :: !(Maybe URL) + , gitTreeSize :: !(Maybe Int) + , gitTreePath :: !Text + , gitTreeMode :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitTree where rnf = genericRnf instance Binary GitTree -data GitCommit = GitCommit { - gitCommitMessage :: !Text - ,gitCommitUrl :: !URL - ,gitCommitCommitter :: !GitUser - ,gitCommitAuthor :: !GitUser - ,gitCommitTree :: !Tree - ,gitCommitSha :: !(Maybe (Name GitCommit)) - ,gitCommitParents :: !(Vector Tree) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitCommit = GitCommit + { gitCommitMessage :: !Text + , gitCommitUrl :: !URL + , gitCommitCommitter :: !GitUser + , gitCommitAuthor :: !GitUser + , gitCommitTree :: !Tree + , gitCommitSha :: !(Maybe (Name GitCommit)) + , gitCommitParents :: !(Vector Tree) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit -data Blob = Blob { - blobUrl :: !URL - ,blobEncoding :: !Text - ,blobContent :: !Text - ,blobSha :: !(Name Blob) - ,blobSize :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Blob = Blob + { blobUrl :: !URL + , blobEncoding :: !Text + , blobContent :: !Text + , blobSha :: !(Name Blob) + , blobSize :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob where rnf = genericRnf instance Binary Blob -data Tag = Tag { - tagName :: !Text - ,tagZipballUrl :: !URL - ,tagTarballUrl :: !URL - ,tagCommit :: !BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Tag = Tag + { tagName :: !Text + , tagZipballUrl :: !URL + , tagTarballUrl :: !URL + , tagCommit :: !BranchCommit + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag where rnf = genericRnf instance Binary Tag -data Branch = Branch { - branchName :: !Text - ,branchCommit :: !BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Branch = Branch + { branchName :: !Text + , branchCommit :: !BranchCommit + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Branch where rnf = genericRnf -data BranchCommit = BranchCommit { - branchCommitSha :: !Text - ,branchCommitUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data BranchCommit = BranchCommit + { branchCommitSha :: !Text + , branchCommitUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf instance Binary BranchCommit -data Diff = Diff { - diffStatus :: !Text - ,diffBehindBy :: !Int - ,diffPatchUrl :: !URL - ,diffUrl :: !URL - ,diffBaseCommit :: !Commit - ,diffCommits :: !(Vector Commit) - ,diffTotalCommits :: !Int - ,diffHtmlUrl :: !URL - ,diffFiles :: !(Vector File) - ,diffAheadBy :: !Int - ,diffDiffUrl :: !URL - ,diffPermalinkUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Diff = Diff + { diffStatus :: !Text + , diffBehindBy :: !Int + , diffPatchUrl :: !URL + , diffUrl :: !URL + , diffBaseCommit :: !Commit + , diffCommits :: !(Vector Commit) + , diffTotalCommits :: !Int + , diffHtmlUrl :: !URL + , diffFiles :: !(Vector File) + , diffAheadBy :: !Int + , diffDiffUrl :: !URL + , diffPermalinkUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf instance Binary Diff -data NewGitReference = NewGitReference { - newGitReferenceRef :: !Text - ,newGitReferenceSha :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewGitReference = NewGitReference + { newGitReferenceRef :: !Text + , newGitReferenceSha :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewGitReference where rnf = genericRnf instance Binary NewGitReference -data GitReference = GitReference { - gitReferenceObject :: !GitObject - ,gitReferenceUrl :: !URL - ,gitReferenceRef :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitReference = GitReference + { gitReferenceObject :: !GitObject + , gitReferenceUrl :: !URL + , gitReferenceRef :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference where rnf = genericRnf instance Binary GitReference -data GitObject = GitObject { - gitObjectType :: !Text - ,gitObjectSha :: !Text - ,gitObjectUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitObject = GitObject + { gitObjectType :: !Text + , gitObjectSha :: !Text + , gitObjectUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf instance Binary GitObject -data GitUser = GitUser { - gitUserName :: !Text - ,gitUserEmail :: !Text - ,gitUserDate :: !UTCTime -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitUser = GitUser + { gitUserName :: !Text + , gitUserEmail :: !Text + , gitUserDate :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser where rnf = genericRnf instance Binary GitUser -data File = File { - fileBlobUrl :: !URL - ,fileStatus :: !Text - ,fileRawUrl :: !URL - ,fileAdditions :: !Int - ,fileSha :: !Text - ,fileChanges :: !Int - ,filePatch :: !(Maybe Text) - ,fileFilename :: !Text - ,fileDeletions :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data File = File + { fileBlobUrl :: !URL + , fileStatus :: !Text + , fileRawUrl :: !URL + , 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 instance Binary File @@ -186,114 +202,116 @@ 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/Issues.hs b/src/GitHub/Data/Issues.hs index fb70c626..7cb8d30f 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -9,6 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name) +import GitHub.Data.Options (IssueState) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude @@ -20,7 +21,7 @@ data Issue = Issue , issueEventsUrl :: !URL , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) - , issueLabels :: (Vector (Name IssueLabel)) + , issueLabels :: (Vector IssueLabel) , issueNumber :: !Int , issueAssignee :: !(Maybe SimpleUser) , issueUser :: !SimpleUser @@ -29,7 +30,7 @@ data Issue = Issue , issueUrl :: !URL , issueCreatedAt :: !UTCTime , issueBody :: !(Maybe Text) - , issueState :: !Text + , issueState :: !IssueState , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) @@ -54,8 +55,8 @@ instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) - , editIssueAssignee :: !(Maybe Text) - , editIssueState :: !(Maybe Text) + , editIssueAssignee :: !(Maybe (Name User)) + , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 39900719..5f0106d8 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -4,6 +4,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- +-- Module with modifiers for pull requests' and issues' listings. module GitHub.Data.Options ( -- * Common modifiers stateOpen, @@ -28,6 +29,7 @@ module GitHub.Data.Options ( sortByComments, optionsLabels, optionsSince, + optionsSinceAll, optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, @@ -42,6 +44,13 @@ module GitHub.Data.Options ( optionsNoAssignee, -- * Data IssueState (..), + -- * Internal + HasState, + HasDirection, + HasCreatedUpdated, + HasComments, + HasLabels, + HasSince, ) where import GitHub.Data.Definitions @@ -58,7 +67,7 @@ import qualified Data.Text.Encoding as TE -- Data ------------------------------------------------------------------------------- --- | Issue or PullRewuest state +-- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state data IssueState = StateOpen | StateClosed @@ -153,6 +162,10 @@ 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 @@ -171,6 +184,10 @@ 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 @@ -188,6 +205,12 @@ instance HasCreatedUpdated IssueMod where sortByUpdated = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueUpdated } +instance HasCreatedUpdated IssueRepoMod where + sortByCreated = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueCreated } + sortByUpdated = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueUpdated } + ------------------------------------------------------------------------------- -- Pull Request ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 56445cdf..3e48efc9 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -167,8 +167,7 @@ instance Binary PullRequestReference ------------------------------------------------------------------------------- instance FromJSON SimplePullRequest where - parseJSON = withObject "SimplePullRequest" $ \o -> - SimplePullRequest + parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -200,8 +199,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" @@ -231,11 +229,11 @@ instance FromJSON PullRequest where <*> o .:? "mergeable" 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 diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index cd19da19..cfef5ca1 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -12,38 +12,40 @@ import Prelude () import qualified Data.Vector as V -data SearchResult entity = SearchResult { - searchResultTotalCount :: !Int - ,searchResultResults :: !(Vector entity) -} deriving (Show, Data, Typeable, 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 :: !URL - ,codeGitUrl :: !URL - ,codeHtmlUrl :: !URL - ,codeRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) + parseJSON = withObject "SearchResult" $ \o -> SearchResult + <$> o .: "total_count" + <*> o .:? "items" .!= V.empty + +data Code = Code + { codeName :: !Text + , codePath :: !Text + , codeSha :: !Text + , codeUrl :: !URL + , codeGitUrl :: !URL + , codeHtmlUrl :: !URL + , codeRepo :: !Repo + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code where rnf = genericRnf instance Binary Code instance FromJSON Code where - parseJSON = withObject "Code" $ \o -> - Code <$> o .: "name" - <*> o .: "path" - <*> o .: "sha" - <*> o .: "url" - <*> o .: "git_url" - <*> o .: "html_url" - <*> o .: "repository" + 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/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 2e49e2e6..ea0604e5 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -5,92 +5,96 @@ -- module GitHub.Data.Webhooks where -import Prelude () - import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Map as M -data RepoWebhook = RepoWebhook { - repoWebhookUrl :: !URL - ,repoWebhookTestUrl :: !URL - ,repoWebhookId :: !(Id RepoWebhook) - ,repoWebhookName :: !Text - ,repoWebhookActive :: !Bool - ,repoWebhookEvents :: !(Vector RepoWebhookEvent) - ,repoWebhookConfig :: !(M.Map Text Text) - ,repoWebhookLastResponse :: !RepoWebhookResponse - ,repoWebhookUpdatedAt :: !UTCTime - ,repoWebhookCreatedAt :: !UTCTime -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhook = RepoWebhook + { repoWebhookUrl :: !URL + , repoWebhookTestUrl :: !URL + , repoWebhookId :: !(Id RepoWebhook) + , repoWebhookName :: !Text + , repoWebhookActive :: !Bool + , repoWebhookEvents :: !(Vector RepoWebhookEvent) + , repoWebhookConfig :: !(M.Map Text Text) + , repoWebhookLastResponse :: !RepoWebhookResponse + , repoWebhookUpdatedAt :: !UTCTime + , repoWebhookCreatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook where rnf = genericRnf instance Binary RepoWebhook -data RepoWebhookEvent = - WebhookWildcardEvent - | WebhookCommitCommentEvent - | WebhookCreateEvent - | WebhookDeleteEvent - | WebhookDeploymentEvent - | WebhookDeploymentStatusEvent - | WebhookForkEvent - | WebhookGollumEvent - | WebhookIssueCommentEvent - | WebhookIssuesEvent - | WebhookMemberEvent - | WebhookPageBuildEvent - | WebhookPingEvent - | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent - | WebhookPullRequestEvent - | WebhookPushEvent - | WebhookReleaseEvent - | WebhookStatusEvent - | WebhookTeamAddEvent - | WebhookWatchEvent - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhookEvent + = WebhookWildcardEvent + | WebhookCommitCommentEvent + | WebhookCreateEvent + | WebhookDeleteEvent + | WebhookDeploymentEvent + | WebhookDeploymentStatusEvent + | WebhookForkEvent + | WebhookGollumEvent + | WebhookIssueCommentEvent + | WebhookIssuesEvent + | WebhookMemberEvent + | WebhookPageBuildEvent + | WebhookPingEvent + | WebhookPublicEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestEvent + | WebhookPushEvent + | WebhookReleaseEvent + | WebhookStatusEvent + | WebhookTeamAddEvent + | WebhookWatchEvent + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf instance Binary RepoWebhookEvent -data RepoWebhookResponse = RepoWebhookResponse { - repoWebhookResponseCode :: !(Maybe Int) - ,repoWebhookResponseStatus :: !Text - ,repoWebhookResponseMessage :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhookResponse = RepoWebhookResponse + { repoWebhookResponseCode :: !(Maybe Int) + , repoWebhookResponseStatus :: !Text + , repoWebhookResponseMessage :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookResponse where rnf = genericRnf instance Binary RepoWebhookResponse -data PingEvent = PingEvent { - pingEventZen :: !Text - ,pingEventHook :: !RepoWebhook - ,pingEventHookId :: !(Id RepoWebhook) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PingEvent = PingEvent + { pingEventZen :: !Text + , pingEventHook :: !RepoWebhook + , pingEventHookId :: !(Id RepoWebhook) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent where rnf = genericRnf instance Binary PingEvent -data NewRepoWebhook = NewRepoWebhook { - newRepoWebhookName :: !Text - ,newRepoWebhookConfig :: !(M.Map Text Text) - ,newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,newRepoWebhookActive :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Typeable, Data, Generic) +data NewRepoWebhook = NewRepoWebhook + { newRepoWebhookName :: !Text + , newRepoWebhookConfig :: !(M.Map Text Text) + , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + , newRepoWebhookActive :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData NewRepoWebhook where rnf = genericRnf instance Binary NewRepoWebhook -data EditRepoWebhook = EditRepoWebhook { - editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) - ,editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,editRepoWebhookActive :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Typeable, Data, Generic) +data EditRepoWebhook = EditRepoWebhook + { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) + , editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookActive :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData EditRepoWebhook where rnf = genericRnf instance Binary EditRepoWebhook @@ -98,70 +102,70 @@ instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent - parseJSON _ = fail "Could not build a Webhook event" + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "ping") = pure WebhookPingEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where - toJSON (WebhookWildcardEvent) = String "*" - toJSON (WebhookCommitCommentEvent) = String "commit_comment" - toJSON (WebhookCreateEvent) = String "create" - toJSON (WebhookDeleteEvent) = String "delete" - toJSON (WebhookDeploymentEvent) = String "deployment" - toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" - toJSON (WebhookForkEvent) = String "fork" - toJSON (WebhookGollumEvent) = String "gollum" - toJSON (WebhookIssueCommentEvent) = String "issue_comment" - toJSON (WebhookIssuesEvent) = String "issues" - toJSON (WebhookMemberEvent) = String "member" - toJSON (WebhookPageBuildEvent) = String "page_build" - toJSON (WebhookPingEvent) = String "ping" - toJSON (WebhookPublicEvent) = String "public" - toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" - toJSON (WebhookPullRequestEvent) = String "pull_request" - toJSON (WebhookPushEvent) = String "push" - toJSON (WebhookReleaseEvent) = String "release" - toJSON (WebhookStatusEvent) = String "status" - toJSON (WebhookTeamAddEvent) = String "team_add" - toJSON (WebhookWatchEvent) = String "watch" + toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookCreateEvent = String "create" + toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeploymentEvent = String "deployment" + toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookForkEvent = String "fork" + toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookIssueCommentEvent = String "issue_comment" + toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookMemberEvent = String "member" + toJSON WebhookPageBuildEvent = String "page_build" + toJSON WebhookPingEvent = String "ping" + toJSON WebhookPublicEvent = String "public" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPushEvent = String "push" + toJSON WebhookReleaseEvent = String "release" + toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookWatchEvent = String "watch" 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 @@ -191,7 +195,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" From 5965743dcb3bb38219d11076cf7c85c8d0ac0e7b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 20:50:42 +0300 Subject: [PATCH 023/309] RO-RA-RW --- src/GitHub/Data/Request.hs | 24 +++++++++++++++++++-- src/GitHub/Endpoints/Activity/Starring.hs | 4 ++-- src/GitHub/Endpoints/GitData/References.hs | 2 +- src/GitHub/Endpoints/Issues.hs | 6 +++--- src/GitHub/Endpoints/Issues/Comments.hs | 4 ++-- src/GitHub/Endpoints/Issues/Labels.hs | 14 ++++++------ src/GitHub/Endpoints/Organizations/Teams.hs | 16 +++++++------- src/GitHub/Endpoints/PullRequests.hs | 6 +++--- src/GitHub/Endpoints/Repos.hs | 8 +++---- src/GitHub/Endpoints/Repos/DeployKeys.hs | 15 ++++++++----- src/GitHub/Endpoints/Repos/Webhooks.hs | 10 ++++----- src/GitHub/Endpoints/Users.hs | 2 +- src/GitHub/Request.hs | 15 +++++++------ 13 files changed, 76 insertions(+), 50 deletions(-) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 604fcd82..b355292e 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -10,6 +10,7 @@ -- module GitHub.Data.Request ( Request(..), + RW(..), CommandMethod(..), toMethod, StatusMap(..), @@ -125,16 +126,35 @@ instance NFData FetchCount where rnf = genericRnf -- Github request ------------------------------------------------------------------------------ +-- | Type used as with @DataKinds@ to tag whether requests need authentication +-- or aren't read-only. +data RW + = RO -- ^ /Read-only/, doesn't necessarily requires authentication + | RA -- ^ /Read autenticated/ + | RW -- ^ /Read-write/, requires authentication + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +{- +data SRO (rw :: RW) where + ROO :: SRO 'RO + ROA :: SRO 'RA + +-- | This class is used to describe read-only (but pontentially +class IReadOnly (rw :: RW) where iro :: SRO rw +instance IReadOnly 'RO where iro = ROO +instance IReadOnly 'RA where iro = ROA +-} + -- | Github request data type. -- -- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. -data Request (k :: Bool) a where +data Request (k :: RW) a where Query :: FromJSON a => Paths -> QueryString -> Request k a PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> FetchCount -> Request k (Vector a) - Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a + Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a StatusQuery :: StatusMap a -> Request k () -> Request k a HeaderQuery :: Types.RequestHeaders -> Request k a -> Request k a deriving (Typeable) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 1661305b..5178cbce 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -56,7 +56,7 @@ myStarred auth = -- | All the repos starred by the authenticated user. -- See -myStarredR :: FetchCount -> Request 'True (Vector Repo) +myStarredR :: FetchCount -> Request 'RA (Vector Repo) myStarredR = PagedQuery ["user", "starred"] [] @@ -67,5 +67,5 @@ myStarredAcceptStar auth = -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: FetchCount -> Request 'True (Vector RepoStarred) +myStarredAcceptStarR :: FetchCount -> Request 'RA (Vector RepoStarred) myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 7e0c6d57..a15ddac3 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -69,7 +69,7 @@ createReference auth user repo newRef = -- | 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) diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index b2b7555c..dc24db99 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -29,7 +29,7 @@ import GitHub.Request import Prelude () -- | See . -currentUserIssuesR :: IssueMod -> FetchCount -> Request k (Vector Issue) +currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) currentUserIssuesR opts = PagedQuery ["user", "issues"] (issueModToQueryString opts) @@ -99,7 +99,7 @@ createIssue auth user repo ni = -- | 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 @@ -119,6 +119,6 @@ editIssue auth user repo iss edit = -- | Edit an issue. -- See -editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'True Issue +editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue editIssueR user repo iss = Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 81a9b52c..67bf0d3b 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -66,7 +66,7 @@ createComment auth user repo iss body = -- | Create a comment. -- See -createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'True Comment +createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'RW Comment createCommentR user repo iss body = Command Post parts (encode $ NewComment body) where @@ -83,7 +83,7 @@ editComment auth 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) where diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 3e4829f7..eab8f4c6 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -87,7 +87,7 @@ createLabel auth user repo lbl color = -- | Create a label. -- See -createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'True IssueLabel +createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel createLabelR user repo lbl color = Command Post paths $ encode body where @@ -114,7 +114,7 @@ updateLabelR :: Name Owner -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color - -> Request 'True IssueLabel + -> Request 'RW IssueLabel updateLabelR user repo oldLbl newLbl color = Command Patch paths (encode body) where @@ -130,7 +130,7 @@ deleteLabel auth user repo lbl = -- | Delete a label. -- See -deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'True () +deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty @@ -173,7 +173,7 @@ 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) where @@ -188,7 +188,7 @@ removeLabelFromIssue auth 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 -> Request 'RW () removeLabelFromIssueR user repo iid lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty @@ -214,7 +214,7 @@ 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) where @@ -229,7 +229,7 @@ removeAllLabelsFromIssue auth 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 -> Request 'RW () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 8e8e9564..ba06ee6a 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -91,7 +91,7 @@ createTeamFor' auth org cteam = -- | 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) @@ -107,7 +107,7 @@ editTeam' auth tid eteam = -- | 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) @@ -121,14 +121,14 @@ deleteTeam' auth tid = -- | Delete team. -- -- See -deleteTeamR :: Id Team -> Request 'True () +deleteTeamR :: Id Team -> Request 'RW () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See -listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'True (Vector SimpleUser) +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 @@ -177,13 +177,13 @@ 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 -> Id Team -> Name Owner -> Role -> IO (Either Error TeamMembership) addTeamMembershipFor' auth tid user role = executeRequest auth $ addTeamMembershipForR tid user role -- | Add team membership. -- See -addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request '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) @@ -196,7 +196,7 @@ deleteTeamMembershipFor' auth tid user = -- | Remove team membership. -- See -deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'True () +deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'RW () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty @@ -208,5 +208,5 @@ listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See -listTeamsCurrentR :: FetchCount -> Request 'True (Vector Team) +listTeamsCurrentR :: FetchCount -> Request 'RW (Vector Team) listTeamsCurrentR = PagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 04c2247f..7c5943e9 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -87,7 +87,7 @@ createPullRequest auth user repo cpr = 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) @@ -102,7 +102,7 @@ updatePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest - -> Request 'True PullRequest + -> Request 'RW PullRequest updatePullRequestR user repo prid epr = Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) @@ -168,7 +168,7 @@ mergePullRequest auth user repo prid commitMessage = -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'True MergeResult +mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d5be2120..d6a13587 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -168,7 +168,7 @@ createRepo' auth nrepo = -- | Create a new repository. -- See -createRepoR :: NewRepo -> Request 'True Repo +createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = Command Post ["user", "repos"] (encode nrepo) @@ -181,7 +181,7 @@ createOrganizationRepo' auth org nrepo = -- | 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) @@ -200,7 +200,7 @@ editRepo auth user repo body = -- | 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) where @@ -365,6 +365,6 @@ deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo -deleteRepoR :: Name Owner -> Name Repo -> Request 'True () +deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () deleteRepoR user repo = Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 99db6ad2..025ee2c8 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -26,12 +26,14 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () --- | Querying deploy keys +-- | Querying deploy keys. deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) deployKeysFor' auth user repo = executeRequest auth $ deployKeysForR user repo FetchAll -deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoDeployKey) +-- | Querying deploy keys. +-- See +deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] @@ -40,7 +42,9 @@ deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Eith deployKeyFor' auth user repo keyId = executeRequest auth $ deployKeyForR user repo keyId -deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request k RepoDeployKey +-- | 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] [] @@ -50,7 +54,8 @@ createRepoDeployKey' auth user repo key = executeRequest auth $ createRepoDeployKeyR user repo key -- | Create a deploy key. -createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'True RepoDeployKey +-- See . +createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = Command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) @@ -60,6 +65,6 @@ deleteRepoDeployKey' auth user repo keyId = -- | Delete a deploy key. -- See -deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'True () +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () deleteRepoDeployKeyR user repo keyId = Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 5a5d6810..4e6c0bf6 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -63,7 +63,7 @@ createRepoWebhook' auth user repo hook = -- | 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) @@ -73,7 +73,7 @@ editRepoWebhook' auth user repo hookId hookEdit = -- | 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) @@ -83,7 +83,7 @@ testPushRepoWebhook' auth user repo hookId = -- | Test a push hook. -- See -testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) @@ -93,7 +93,7 @@ pingRepoWebhook' auth user repo hookId = -- | Ping a hook. -- See -pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) @@ -103,7 +103,7 @@ deleteRepoWebhook' auth user repo hookId = -- | Delete a hook. -- See -deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True () +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () deleteRepoWebhookR user repo hookId = Command Delete (createWebhookOpPath user repo hookId Nothing) mempty diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 71ebca84..592e6636 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -52,5 +52,5 @@ userInfoCurrent' auth = -- | Query the authenticated user. -- See -userInfoCurrentR :: Request 'True User +userInfoCurrentR :: Request 'RA User userInfoCurrentR = Query ["user"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a652525a..7a02d78f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -139,7 +139,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. -executeRequest' :: Request 'False a -> IO (Either Error a) +executeRequest' :: Request 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req @@ -149,13 +149,14 @@ executeRequest' req = do pure x -- | Like 'executeRequestWithMgr' but without authentication. -executeRequestWithMgr' :: Manager - -> Request 'False a - -> IO (Either Error a) +executeRequestWithMgr' + :: Manager + -> Request 'RO a + -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ execute req where - execute :: Request 'False a -> ExceptT Error IO a + execute :: Request 'RO b -> ExceptT Error IO b execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest Nothing req @@ -178,12 +179,12 @@ executeRequestWithMgr' mgr req = runExceptT $ -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'False a +executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. -unsafeDropAuthRequirements :: Request 'True a -> Request k a +unsafeDropAuthRequirements :: Request k' a -> Request k a unsafeDropAuthRequirements (Query ps qs) = Query ps qs unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r From 1ce5abba8c01c7a08cabdce30800fda273868895 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 21:30:19 +0300 Subject: [PATCH 024/309] Split 'SimpleRequest' out of Request --- src/GitHub/Data.hs | 4 +- src/GitHub/Data/Milestone.hs | 4 +- src/GitHub/Data/Options.hs | 14 +- src/GitHub/Data/PullRequests.hs | 38 ++- src/GitHub/Data/Request.hs | 166 +++++++------ src/GitHub/Endpoints/Activity/Starring.hs | 6 +- src/GitHub/Endpoints/Activity/Watching.hs | 4 +- src/GitHub/Endpoints/Gists.hs | 6 +- src/GitHub/Endpoints/Gists/Comments.hs | 4 +- src/GitHub/Endpoints/GitData/Blobs.hs | 2 +- src/GitHub/Endpoints/GitData/Commits.hs | 2 +- src/GitHub/Endpoints/GitData/References.hs | 8 +- src/GitHub/Endpoints/GitData/Trees.hs | 4 +- src/GitHub/Endpoints/Issues.hs | 12 +- src/GitHub/Endpoints/Issues/Comments.hs | 8 +- src/GitHub/Endpoints/Issues/Events.hs | 6 +- src/GitHub/Endpoints/Issues/Labels.hs | 22 +- src/GitHub/Endpoints/Issues/Milestones.hs | 5 +- src/GitHub/Endpoints/Organizations.hs | 4 +- src/GitHub/Endpoints/Organizations/Members.hs | 6 +- src/GitHub/Endpoints/Organizations/Teams.hs | 28 ++- src/GitHub/Endpoints/PullRequests.hs | 16 +- .../Endpoints/PullRequests/ReviewComments.hs | 4 +- src/GitHub/Endpoints/Repos.hs | 28 +-- src/GitHub/Endpoints/Repos/Collaborators.hs | 4 +- src/GitHub/Endpoints/Repos/Comments.hs | 6 +- src/GitHub/Endpoints/Repos/Commits.hs | 6 +- src/GitHub/Endpoints/Repos/DeployKeys.hs | 8 +- src/GitHub/Endpoints/Repos/Forks.hs | 2 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 14 +- src/GitHub/Endpoints/Search.hs | 9 +- src/GitHub/Endpoints/Users.hs | 6 +- src/GitHub/Endpoints/Users/Followers.hs | 6 +- src/GitHub/Request.hs | 229 +++++++++--------- 34 files changed, 380 insertions(+), 311 deletions(-) diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 1a8e9c1b..c6cb79b3 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -63,12 +63,12 @@ import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Issues -import GitHub.Data.Name import GitHub.Data.Milestone +import GitHub.Data.Name +import GitHub.Data.Options import GitHub.Data.PullRequests import GitHub.Data.Repos import GitHub.Data.Request -import GitHub.Data.Options import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.URL diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 8141e2c8..26c861de 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -6,8 +6,8 @@ module GitHub.Data.Milestone where import GitHub.Data.Definitions -import GitHub.Data.Id (Id) -import GitHub.Data.URL (URL) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 5f0106d8..285dec0e 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -54,10 +54,10 @@ module GitHub.Data.Options ( ) where import GitHub.Data.Definitions -import GitHub.Data.Id (Id, untagId) -import GitHub.Data.Name (Name, untagName) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Milestone (Milestone) +import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude -import GitHub.Data.Milestone (Milestone) import Prelude () import qualified Data.Text as T @@ -513,7 +513,7 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = FilterBy x' -> TE.encodeUtf8 (f x') milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone - assignee' = filt untagName issueRepoOptionsAssignee + assignee' = filt untagName issueRepoOptionsAssignee state' = case issueRepoOptionsState of Nothing -> "all" @@ -538,11 +538,11 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> - opts { issueRepoOptionsMilestone = FilterAny } + opts { issueRepoOptionsMilestone = FilterAny } optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> - opts { issueRepoOptionsMilestone = FilterNone } + opts { issueRepoOptionsMilestone = FilterNone } optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> @@ -550,4 +550,4 @@ optionsAnyAssignee = IssueRepoMod $ \opts -> optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> - opts { issueRepoOptionsAssignee = FilterNone } + opts { issueRepoOptionsAssignee = FilterNone } diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 3e48efc9..e2b5cef3 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -13,12 +13,15 @@ module GitHub.Data.PullRequests ( PullRequestEvent(..), PullRequestEventType(..), PullRequestReference(..), + MergeResult(..), + statusMerge, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..)) import GitHub.Data.Repos (Repo) +import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -40,7 +43,8 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestMergedAt :: !(Maybe UTCTime) , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest @@ -73,7 +77,8 @@ data PullRequest = PullRequest , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest where rnf = genericRnf instance Binary PullRequest @@ -82,13 +87,14 @@ data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) , editPullRequestState :: !(Maybe IssueState) - } deriving (Show, Generic) + } + deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf instance Binary EditPullRequest -data CreatePullRequest = - CreatePullRequest +data CreatePullRequest + = CreatePullRequest { createPullRequestTitle :: !Text , createPullRequestBody :: !Text , createPullRequestHead :: !Text @@ -99,7 +105,7 @@ data CreatePullRequest = , createPullRequestHead :: !Text , createPullRequestBase :: !Text } - deriving (Show, Generic) + deriving (Show, Generic) instance NFData CreatePullRequest where rnf = genericRnf instance Binary CreatePullRequest @@ -109,7 +115,8 @@ data PullRequestLinks = PullRequestLinks , pullRequestLinksComments :: !URL , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks where rnf = genericRnf instance Binary PullRequestLinks @@ -120,7 +127,8 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !Repo - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit where rnf = genericRnf instance Binary PullRequestCommit @@ -275,3 +283,17 @@ newtype Href a = Href { getHref :: a } instance FromJSON a => FromJSON (Href a) where parseJSON = withObject "href object" $ \obj -> Href <$> obj .: "href" + +-- | Pull request merge results +data MergeResult + = MergeSuccessful + | MergeCannotPerform + | MergeConflict + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + +statusMerge :: StatusMap MergeResult +statusMerge = + [ (204, MergeSuccessful) + , (405, MergeCannotPerform) + , (409, MergeConflict) + ] diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index b355292e..04877130 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -9,12 +9,17 @@ -- Maintainer : Oleg Grenrus -- module GitHub.Data.Request ( - Request(..), + -- * Request + Request (..), + SimpleRequest (..), + -- * Smart constructors + query, pagedQuery, command, + -- * Auxiliary types RW(..), + StatusMap, + statusOnlyOk, CommandMethod(..), toMethod, - StatusMap(..), - MergeResult(..), FetchCount(..), Paths, IsPathPart(..), @@ -74,30 +79,6 @@ 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) - -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. data FetchCount = FetchAtLeast !Word | FetchAll @@ -152,51 +133,87 @@ instance IReadOnly 'RA where iro = ROA -- -- /Note:/ 'Request' is not 'Functor' on purpose. data Request (k :: RW) a where - Query :: FromJSON a => Paths -> QueryString -> Request k a - PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> FetchCount -> Request k (Vector a) - Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW 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) + SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a + StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a + HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a + deriving (Typeable) + +data SimpleRequest (k :: RW) a where + Query :: Paths -> QueryString -> SimpleRequest k a + PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a) + Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a + deriving (Typeable) + +------------------------------------------------------------------------------- +-- Status Map +------------------------------------------------------------------------------- + +-- TODO: Change to 'Map' ? +type StatusMap a = [(Int, a)] + +statusOnlyOk :: StatusMap Bool +statusOnlyOk = + [ (202, True) + , (404, False) + ] + +------------------------------------------------------------------------------- +-- Smart constructors +------------------------------------------------------------------------------- + +query :: FromJSON a => Paths -> QueryString -> Request k a +query ps qs = SimpleQuery (Query ps qs) + +pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request k (Vector a) +pagedQuery ps qs fc = SimpleQuery (PagedQuery ps qs fc) + +command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a +command m ps body = SimpleQuery (Command m ps body) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +deriving instance Eq a => Eq (Request k a) +deriving instance Eq a => Eq (SimpleRequest k a) + +instance Show (SimpleRequest k a) where + showsPrec d r = showParen (d > appPrec) $ case r of + Query ps qs -> showString "Query " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs + PagedQuery ps qs l -> showString "PagedQuery " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs + . showString " " + . showsPrec (appPrec + 1) l + Command m ps body -> showString "Command " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) body + where + appPrec = 10 :: Int instance Show (Request k a) where - showsPrec d r = - 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 + showsPrec d r = showParen (d > appPrec) $ case r of + SimpleQuery req -> showString "SimpleQuery " + . showsPrec (appPrec + 1) req + StatusQuery m req -> showString "Status " + . showsPrec (appPrec + 1) (map fst m) -- !!! printing only keys + . showString " " + . showsPrec (appPrec + 1) req + HeaderQuery m req -> showString "Header " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) req + where + appPrec = 10 :: Int + +instance Hashable (SimpleRequest k a) where hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps @@ -211,11 +228,16 @@ instance Hashable (Request k a) where `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body + +instance Hashable a => Hashable (Request k a) where + hashWithSalt salt (SimpleQuery req) = + salt `hashWithSalt` (0 :: Int) + `hashWithSalt` req hashWithSalt salt (StatusQuery sm req) = - salt `hashWithSalt` (3 :: Int) + salt `hashWithSalt` (1 :: Int) `hashWithSalt` sm `hashWithSalt` req hashWithSalt salt (HeaderQuery h req) = - salt `hashWithSalt` (4 :: Int) + salt `hashWithSalt` (2 :: Int) `hashWithSalt` h `hashWithSalt` req diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 5178cbce..7ca84c34 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -34,7 +34,7 @@ stargazersFor auth user repo = -- See stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- @@ -47,7 +47,7 @@ reposStarredBy auth user = -- See reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = - PagedQuery ["users", toPathPart user, "starred"] [] + pagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) @@ -57,7 +57,7 @@ myStarred auth = -- | All the repos starred by the authenticated user. -- See myStarredR :: FetchCount -> Request 'RA (Vector Repo) -myStarredR = PagedQuery ["user", "starred"] [] +myStarredR = pagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 9e096053..34914e32 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -39,7 +39,7 @@ watchersFor' auth user repo = -- See watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = - PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit + pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- @@ -59,4 +59,4 @@ reposWatchedBy' auth user = -- See reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = - PagedQuery ["users", toPathPart user, "subscriptions"] [] + pagedQuery ["users", toPathPart user, "subscriptions"] [] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 6804a092..77d7bced 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -35,7 +35,7 @@ gists = gists' Nothing -- | List gists. -- See gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) -gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] +gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- @@ -52,6 +52,6 @@ gist = gist' Nothing -- | 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] [] diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 60a27caa..98da18c2 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -29,7 +29,7 @@ commentsOn gid = -- See commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = - PagedQuery ["gists", toPathPart gid, "comments"] [] + pagedQuery ["gists", toPathPart gid, "comments"] [] -- | A specific comment, by the comment ID. -- @@ -42,4 +42,4 @@ comment cid = -- 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 33ab8437..355a6e8a 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -34,4 +34,4 @@ blob = blob' Nothing -- 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 87bb6fac..1d8ced18 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -27,4 +27,4 @@ commit user repo sha = -- 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 a15ddac3..d010e1b7 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -41,7 +41,7 @@ reference = reference' Nothing -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = - Query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] + query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- @@ -60,7 +60,7 @@ references = references' Nothing -- See referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) @@ -71,7 +71,7 @@ createReference auth user repo newRef = -- See createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = - Command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) + command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- @@ -84,4 +84,4 @@ namespacedReferences user repo namespace = -- See 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 29f27abe..1806561a 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -37,7 +37,7 @@ tree = tree' Nothing -- See treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] + query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] -- | A recursively-nested tree for a SHA1. -- @@ -56,4 +56,4 @@ nestedTree = nestedTree' Nothing -- 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 dc24db99..431e1c3e 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -31,12 +31,12 @@ import Prelude () -- | See . currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) currentUserIssuesR opts = - PagedQuery ["user", "issues"] (issueModToQueryString opts) + pagedQuery ["user", "issues"] (issueModToQueryString opts) -- | See . organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) organizationIssuesR org opts = - PagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) + pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' @@ -57,7 +57,7 @@ issue = issue' Nothing -- See issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue issueR user reqRepoName reqIssueNumber = - Query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] + query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. @@ -78,7 +78,7 @@ issuesForRepo = issuesForRepo' Nothing -- See issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) issuesForRepoR user reqRepoName opts = - PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs + pagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = issueRepoModToQueryString opts @@ -101,7 +101,7 @@ createIssue auth user repo ni = -- See 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. @@ -121,4 +121,4 @@ editIssue auth user repo iss edit = -- See editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue editIssueR user repo iss = - Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode + 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 67bf0d3b..508fc642 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -34,7 +34,7 @@ comment user repo cid = -- 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] [] + query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- @@ -53,7 +53,7 @@ comments' auth user repo iid = -- See commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a new comment. -- @@ -68,7 +68,7 @@ createComment auth user repo iss body = -- See createCommentR :: Name Owner -> Name Repo -> Id Issue -> 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"] @@ -85,6 +85,6 @@ editComment auth user repo commid body = -- See 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] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index bf108cee..9bc22a9b 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -40,7 +40,7 @@ eventsForIssue' auth user repo iid = -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector Event) eventsForIssueR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- @@ -59,7 +59,7 @@ eventsForRepo' auth user repo = -- See eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Event) eventsForRepoR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- @@ -78,4 +78,4 @@ event' auth user repo eid = -- See eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event eventR user repo eid = - Query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart 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 eab8f4c6..4b4c8628 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -57,7 +57,7 @@ labelsOnRepo' auth user repo = -- See labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] -- | A label by name. -- @@ -76,7 +76,7 @@ label' auth user repo lbl = -- See labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = - Query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] + query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label -- @@ -89,7 +89,7 @@ createLabel auth user repo lbl color = -- See createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel createLabelR user repo lbl color = - Command Post paths $ encode body + command Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] @@ -116,7 +116,7 @@ updateLabelR :: Name Owner -> String -- ^ new color -> Request 'RW IssueLabel updateLabelR user repo oldLbl newLbl color = - Command Patch paths (encode body) + command Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] @@ -132,7 +132,7 @@ deleteLabel auth user repo lbl = -- See deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () deleteLabelR user repo lbl = - Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- @@ -151,7 +151,7 @@ labelsOnIssue' auth user repo iid = -- See labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] -- | Add labels to an issue. -- @@ -175,7 +175,7 @@ addLabelsToIssueR :: Foldable f -> f (Name 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"] @@ -190,7 +190,7 @@ removeLabelFromIssue auth user repo iid lbl = -- See removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'RW () removeLabelFromIssueR user repo iid lbl = - Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty + 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. -- @@ -216,7 +216,7 @@ replaceAllLabelsForIssueR :: Foldable f -> f (Name 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"] @@ -231,7 +231,7 @@ removeAllLabelsFromIssue auth user repo iid = -- See removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'RW () removeAllLabelsFromIssueR user repo iid = - Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- @@ -250,4 +250,4 @@ labelsOnMilestone' auth user repo mid = -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] + 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 65106975..9f541112 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -35,7 +35,8 @@ milestones' auth user repo = -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) -milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] +milestonesR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- @@ -48,4 +49,4 @@ milestone user repo mid = -- 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] [] diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 098d39cc..8bbc9efe 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -35,7 +35,7 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) -publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] +publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- @@ -52,4 +52,4 @@ publicOrganization = publicOrganization' Nothing -- | 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 f3588f56..acb0d366 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -37,13 +37,15 @@ membersOf = membersOf' Nothing -- -- See membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) -membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] +membersOfR organization = + pagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) -membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] +membersOfWithR org f r = + pagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] where f' = case f of OrgMemberFilter2faDisabled -> "2fa_disabled" diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index ba06ee6a..0bdcf89c 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -57,7 +57,8 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) -teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] +teamsOfR org = + pagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- With authentication @@ -77,7 +78,7 @@ teamInfoFor = teamInfoFor' Nothing -- See teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = - Query ["teams", toPathPart tid] [] + query ["teams", toPathPart tid] [] -- | Create a team under an Owner -- @@ -93,7 +94,7 @@ createTeamFor' auth org cteam = -- See createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = - Command Post ["orgs", toPathPart org, "teams"] (encode cteam) + command Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- @@ -109,7 +110,7 @@ editTeam' auth tid eteam = -- See 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. -- @@ -123,13 +124,14 @@ deleteTeam' auth tid = -- See deleteTeamR :: Id Team -> Request 'RW () deleteTeamR tid = - Command Delete ["teams", toPathPart tid] mempty + command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) -listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] +listTeamMembersR tid r = + pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of TeamMemberRoleAll -> "all" @@ -146,7 +148,8 @@ listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll -- | Query team repositories. -- See listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) -listTeamReposR tid = PagedQuery ["teams", toPathPart tid, "repos"] [] +listTeamReposR tid = + pagedQuery ["teams", toPathPart tid, "repos"] [] -- | Retrieve repositories for a team. -- @@ -166,7 +169,7 @@ teamMembershipInfoFor' auth tid user = -- See Name Owner -> Request k TeamMembership teamMembershipInfoForR tid user = - Query ["teams", toPathPart tid, "memberships", toPathPart user] [] + query ["teams", toPathPart tid, "memberships", toPathPart user] [] -- | Retrieve team mebership information for a user. -- @@ -185,7 +188,7 @@ addTeamMembershipFor' auth tid user role = -- See addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = - Command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) + command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Delete a member of a team. -- @@ -198,7 +201,7 @@ deleteTeamMembershipFor' auth tid user = -- See deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'RW () deleteTeamMembershipForR tid user = - Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty + command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- @@ -208,5 +211,6 @@ listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See -listTeamsCurrentR :: FetchCount -> Request 'RW (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 7c5943e9..edb66509 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -48,7 +48,7 @@ pullRequestsForR -> PullRequestMod -> FetchCount -> Request k (Vector SimplePullRequest) -pullRequestsForR user repo opts = PagedQuery +pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) @@ -72,7 +72,7 @@ pullRequest = pullRequest' Nothing -- See pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest pullRequestR user repo prid = - Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] createPullRequest :: Auth -> Name Owner @@ -89,7 +89,7 @@ createPullRequestR :: Name Owner -> CreatePullRequest -> Request 'RW PullRequest createPullRequestR user repo cpr = - Command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode 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) @@ -104,7 +104,7 @@ updatePullRequestR :: Name Owner -> EditPullRequest -> Request 'RW PullRequest updatePullRequestR user repo prid epr = - Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode 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. @@ -126,7 +126,7 @@ pullRequestCommitsIO = pullRequestCommits' Nothing -- See pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] + 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. @@ -148,7 +148,7 @@ pullRequestFiles = pullRequestFiles' Nothing -- See pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] + 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) @@ -158,7 +158,7 @@ isPullRequestMerged auth user repo prid = -- | Query if a pull request has been merged. -- See isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool -isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $ +isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. @@ -169,7 +169,7 @@ mergePullRequest auth user repo prid commitMessage = -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult -mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ +mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 3fe77333..eee75046 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -29,7 +29,7 @@ pullRequestReviewCommentsIO user repo prid = -- See pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) pullRequestReviewCommentsR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- @@ -42,4 +42,4 @@ pullRequestReviewComment user repo cid = -- 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] [] + query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d6a13587..b16ae23a 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -78,7 +78,7 @@ currentUserRepos auth publicity = -- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = - PagedQuery ["user", "repos"] qs + pagedQuery ["user", "repos"] qs where qs = repoPublicityQueryString publicity @@ -105,7 +105,7 @@ userRepos' auth user publicity = -- 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 @@ -135,7 +135,7 @@ organizationReposR -> FetchCount -> Request k (Vector Repo) organizationReposR org publicity = - PagedQuery ["orgs", toPathPart org, "repos"] qs + pagedQuery ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity @@ -157,7 +157,7 @@ repository' auth user repo = -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = - Query ["repos", toPathPart user, toPathPart repo] [] + query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- @@ -170,7 +170,7 @@ createRepo' auth nrepo = -- See 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. -- @@ -183,7 +183,7 @@ createOrganizationRepo' auth org nrepo = -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = - Command Post ["orgs", toPathPart org, "repos"] (encode nrepo) + command Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- @@ -202,7 +202,7 @@ editRepo auth user repo body = -- See 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} @@ -230,7 +230,7 @@ contributorsR -> 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 = [] @@ -273,7 +273,7 @@ languagesFor' auth user repo = -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = - Query ["repos", toPathPart user, toPathPart repo, "languages"] [] + query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- @@ -293,7 +293,7 @@ tagsFor' auth user repo = -- See tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- @@ -313,7 +313,7 @@ branchesFor' auth user repo = -- See branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] + 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 -- @@ -336,7 +336,7 @@ contentsForR -> Maybe Text -- ^ Git commit -> Request k Content contentsForR user repo path ref = - Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs + query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref @@ -356,7 +356,7 @@ readmeFor' auth user repo = readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = - Query ["repos", toPathPart user, toPathPart repo, "readme"] [] + query ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | Delete an existing repository. -- @@ -367,4 +367,4 @@ deleteRepo auth user repo = deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () deleteRepoR user repo = - Command Delete ["repos", toPathPart user, toPathPart repo] mempty + command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 36b47c89..1504ca0f 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -35,7 +35,7 @@ collaboratorsOn' auth user repo = -- See 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. @@ -56,5 +56,5 @@ isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> Request k Bool -isCollaboratorOnR user repo coll = StatusQuery StatusOnlyOk $ +isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 6fd4dcc7..5adcf814 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -42,7 +42,7 @@ commentsFor' auth user repo = -- See commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- @@ -62,7 +62,7 @@ commitCommentsFor' auth user repo sha = -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = - PagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- @@ -81,4 +81,4 @@ commitCommentFor' auth user repo cid = -- 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 b6ccf5be..ba86ed40 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -74,7 +74,7 @@ commitsWithOptionsFor' auth user repo opts = -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR user repo limit opts = - PagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts @@ -97,7 +97,7 @@ commit' auth user repo sha = -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] + query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] -- | The diff between two treeishes on a repo. -- @@ -116,4 +116,4 @@ diff' auth user repo base headref = -- 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/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 025ee2c8..90b87703 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -35,7 +35,7 @@ deployKeysFor' auth user repo = -- See deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] -- | Querying a deploy key deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) @@ -46,7 +46,7 @@ deployKeyFor' auth user repo keyId = -- See deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = - Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] + query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] -- | Create a deploy key createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) @@ -57,7 +57,7 @@ createRepoDeployKey' auth user repo 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) + command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) deleteRepoDeployKey' auth user repo keyId = @@ -67,4 +67,4 @@ deleteRepoDeployKey' auth user repo keyId = -- See deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () deleteRepoDeployKeyR user repo keyId = - Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 8b95c208..b5cad183 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -35,4 +35,4 @@ forksFor' auth user repo = -- See 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/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 4e6c0bf6..ebb7377d 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -45,7 +45,7 @@ webhooksFor' auth user repo = -- See webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = @@ -55,7 +55,7 @@ webhookFor' auth user repo hookId = -- See webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = - Query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart 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 = @@ -65,7 +65,7 @@ createRepoWebhook' auth user repo hook = -- See createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = - Command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) + 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 = @@ -75,7 +75,7 @@ editRepoWebhook' auth user repo hookId hookEdit = -- See editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = - Command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) + 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 = @@ -84,7 +84,7 @@ testPushRepoWebhook' auth user repo hookId = -- | Test a push hook. -- See testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ +testPushRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) @@ -94,7 +94,7 @@ pingRepoWebhook' auth user repo hookId = -- | Ping a hook. -- See pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ +pingRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) @@ -105,7 +105,7 @@ deleteRepoWebhook' auth user repo hookId = -- See deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () deleteRepoWebhookR user repo hookId = - Command Delete (createWebhookOpPath user repo hookId Nothing) mempty + command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 86f125d3..58a0e4e5 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -42,7 +42,8 @@ searchRepos = searchRepos' Nothing -- | Search repositories. -- See searchReposR :: Text -> Request k (SearchResult Repo) -searchReposR searchString = Query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] +searchReposR searchString = + query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. @@ -61,7 +62,8 @@ searchCode = searchCode' Nothing -- | Search code. -- See searchCodeR :: Text -> Request k (SearchResult Code) -searchCodeR searchString = Query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] +searchCodeR searchString = + query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. @@ -80,4 +82,5 @@ searchIssues = searchIssues' Nothing -- | Search issues. -- See searchIssuesR :: Text -> Request k (SearchResult Issue) -searchIssuesR searchString = Query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] +searchIssuesR searchString = + query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 592e6636..f7dfdf07 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -36,12 +36,12 @@ userInfoFor = executeRequest' . userInfoForR -- | Query a single user. -- See 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] [] +ownerInfoForR owner = query ["users", toPathPart owner] [] -- | Retrieve information about the user associated with the supplied authentication. -- @@ -53,4 +53,4 @@ userInfoCurrent' auth = -- | Query the authenticated user. -- See userInfoCurrentR :: Request 'RA User -userInfoCurrentR = Query ["user"] [] +userInfoCurrentR = query ["user"] [] diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index f112e424..8ab72ce4 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -28,7 +28,8 @@ usersFollowing user = -- | List followers of a user. -- See usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) -usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] +usersFollowingR user = + pagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- @@ -40,4 +41,5 @@ usersFollowedBy user = -- | List users followed by another user. -- See usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) -usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] +usersFollowedByR user = + pagedQuery ["users", toPathPart user, "following"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 7a02d78f..75ecaf0f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -43,6 +43,7 @@ module GitHub.Request ( unsafeDropAuthRequirements, -- * Helpers makeHttpRequest, + makeHttpSimpleRequest, parseResponse, parseStatus, getNextUrl, @@ -68,12 +69,11 @@ import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, httpLbs, method, newManager, requestBody, requestHeaders, setQueryString) -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, Status (..)) -import Network.URI (URI) +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, Status (..)) +import Network.URI (URI) #if !MIN_VERSION_http_client(0,5,0) import qualified Control.Exception as E @@ -105,41 +105,44 @@ lessFetchCount _ FetchAll = True lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. -executeRequestWithMgr :: Manager - -> Auth - -> Request k a - -> IO (Either Error a) -executeRequestWithMgr mgr auth req = runExceptT $ - execute req +executeRequestWithMgr + :: Manager + -> Auth + -> Request k a + -> IO (Either Error a) +executeRequestWithMgr 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 v = lessFetchCount (V.length v) 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' req' = lift (httpLbs req' mgr) `catch` onHttpException + performHttpReq :: HTTP.Request -> Request k b -> ExceptT Error IO b + performHttpReq httpReq (SimpleQuery sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (HeaderQuery _ sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (StatusQuery sm _) = do + res <- httpLbs' httpReq + parseStatus sm . responseStatus $ res + + performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b + performHttpReq' httpReq Query {} = do + res <- httpLbs' httpReq + parseResponse res + performHttpReq' httpReq (PagedQuery _ _ l) = + performPagedRequest httpLbs' predicate httpReq + where + predicate v = lessFetchCount (V.length v) l + performHttpReq' httpReq (Command m _ _) = do + res <- httpLbs' httpReq + case m of + Delete -> pure () + _ -> parseResponse res + + -- | Like 'executeRequest' but without authentication. -executeRequest' :: Request 'RO a -> IO (Either Error a) +executeRequest' ::Request 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req @@ -153,39 +156,41 @@ executeRequestWithMgr' :: Manager -> Request 'RO a -> IO (Either Error a) -executeRequestWithMgr' mgr req = runExceptT $ - execute req +executeRequestWithMgr' mgr req = runExceptT $ do + httpReq <- makeHttpRequest Nothing req + performHttpReq httpReq req where - execute :: Request 'RO b -> ExceptT Error IO b - 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 v = lessFetchCount (V.length v) 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 + performHttpReq :: HTTP.Request -> Request 'RO b -> ExceptT Error IO b + performHttpReq httpReq (SimpleQuery sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (HeaderQuery _ sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (StatusQuery sm _) = do + res <- httpLbs' httpReq + parseStatus sm . responseStatus $ res + + performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b + performHttpReq' httpReq Query {} = do + res <- httpLbs' httpReq + parseResponse res + performHttpReq' httpReq (PagedQuery _ _ l) = + performPagedRequest httpLbs' predicate httpReq + where + predicate v = lessFetchCount (V.length v) l + -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'RO a - -> IO (Either Error a) +executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. unsafeDropAuthRequirements :: Request k' a -> Request k a -unsafeDropAuthRequirements (Query ps qs) = Query ps qs +unsafeDropAuthRequirements (SimpleQuery (Query ps qs)) = + SimpleQuery (Query ps qs) unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r @@ -202,39 +207,52 @@ unsafeDropAuthRequirements r = -- @ -- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request' -- @ -makeHttpRequest :: MonadThrow m - => Maybe Auth - -> Request k a - -> m HTTP.Request +makeHttpRequest + :: MonadThrow m + => Maybe Auth + -> Request k a + -> m HTTP.Request makeHttpRequest auth r = case r of + SimpleQuery req -> + makeHttpSimpleRequest auth req StatusQuery sm req -> do - req' <- makeHttpRequest auth req + req' <- makeHttpSimpleRequest auth req return $ setCheckStatus (Just sm) req' + HeaderQuery h req -> do + req' <- makeHttpSimpleRequest auth req + return $ req' { requestHeaders = h <> requestHeaders req' } + +makeHttpSimpleRequest + :: MonadThrow m + => Maybe Auth + -> SimpleRequest k a + -> m HTTP.Request +makeHttpSimpleRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs - $ req + return + $ setReqHeaders + . setCheckStatus Nothing + . setAuthRequest auth + . setQueryString qs + $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs - $ req + return + $ setReqHeaders + . setCheckStatus Nothing + . setAuthRequest auth + . setQueryString qs + $ 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' } + return + $ setReqHeaders + . setCheckStatus Nothing + . setAuthRequest auth + . setBody body + . setMethod (toMethod m) + $ req where parseUrl' :: MonadThrow m => Text -> m HTTP.Request #if MIN_VERSION_http_client(0,4,30) @@ -254,13 +272,6 @@ makeHttpRequest auth r = case r of setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } - setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -#if MIN_VERSION_http_client(0,5,0) - setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } -#else - setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } -#endif - setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } @@ -281,8 +292,6 @@ makeHttpRequest auth r = case r of getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] getOAuthHeader _ = [] - - -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do @@ -313,15 +322,10 @@ parseResponse res = case eitherDecode (responseBody res) of -- 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) +parseStatus m (Status sci _) = + maybe err return $ lookup sci m + where + err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- @@ -332,11 +336,12 @@ parseStatus StatusMerge (Status sci _) -- -> 'HTTP.Request' -- -> 'ExceptT' 'Error' 'IO' 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 + :: 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 res <- httpLbs' initReq m <- parseResponse res @@ -356,6 +361,15 @@ performPagedRequest httpLbs' predicate initReq = do -- Internal ------------------------------------------------------------------------------- + +setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request +#if MIN_VERSION_http_client(0,5,0) +setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } +#else +setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } +#endif + + #if MIN_VERSION_http_client(0,5,0) successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () successOrMissing sm _req res @@ -374,9 +388,8 @@ successOrMissing sm s@(Status sci _) hs cookiejar where #endif check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just StatusOnlyOk -> sci == 204 || sci == 404 - Just StatusMerge -> sci `elem` [204, 405, 409] + Nothing -> 200 <= sci && sci < 300 + Just sm' -> sci `elem` map fst sm' onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError From c479f07c9ffe903e5d8a5a8f89b1d5e59f3944cd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 14 Sep 2016 12:46:22 +0300 Subject: [PATCH 025/309] Fix operational sample --- samples/Operational/Operational.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 7819914e..751cf69d 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -12,7 +12,7 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified GitHub as GH -type GithubMonad a = Program (GH.Request 'False) a +type GithubMonad a = Program (GH.Request 'GH.RA) a runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a runMonad mgr auth m = case view m of @@ -21,7 +21,7 @@ runMonad mgr auth m = case view m of b <- ExceptT $ GH.executeRequestWithMgr mgr auth req runMonad mgr auth (k b) -githubRequest :: GH.Request 'False a -> GithubMonad a +githubRequest :: GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton main :: IO () From 70283feaa02644869b91b3153ab33ace3651c4c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 14 Sep 2016 13:48:45 +0300 Subject: [PATCH 026/309] teamName and teamSlug types --- CHANGELOG.md | 2 ++ src/GitHub/Data/Teams.hs | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 84527b7b..657d186e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ Changes for 0.15.0 - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` - Add 'userIssuesR' - Add 'organizationIssuesR' +- Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` +- Refactor 'Request' structure Changes for 0.14.1 diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 2ee0b63c..5df040c7 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -52,8 +52,8 @@ instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) ,teamUrl :: !URL - ,teamName :: !(Name Team) - ,teamSlug :: !Text + ,teamName :: !Text + ,teamSlug :: !(Name Team) ,teamDescription :: !(Maybe Text) ,teamPrivacy :: !(Maybe Privacy) ,teamPermission :: !Permission From dd149a469cad0fb4ecbb75a76efc633d92870a0c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 15 Sep 2016 12:35:40 +0300 Subject: [PATCH 027/309] Make less Hashable (Request) less restrictive --- src/GitHub/Data/Request.hs | 4 ++-- stack-nightly.yaml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 04877130..f6481b60 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -229,13 +229,13 @@ instance Hashable (SimpleRequest k a) where `hashWithSalt` ps `hashWithSalt` body -instance Hashable a => Hashable (Request k a) where +instance Hashable (Request k a) where hashWithSalt salt (SimpleQuery req) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` req hashWithSalt salt (StatusQuery sm req) = salt `hashWithSalt` (1 :: Int) - `hashWithSalt` sm + `hashWithSalt` map fst sm `hashWithSalt` req hashWithSalt salt (HeaderQuery h req) = salt `hashWithSalt` (2 :: Int) diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 14000e13..0511b9a1 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2016-09-12 +resolver: nightly-2016-09-14 packages: - '.' - 'samples/' From 5342a265fab7afa81470461558d8c20bc3cc1593 Mon Sep 17 00:00:00 2001 From: iphydf Date: Sun, 25 Sep 2016 04:07:59 +0100 Subject: [PATCH 028/309] Add mergeable_state and make PR body nullable. Fixes #245. Fixes #246. --- src/GitHub/Data/PullRequests.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index e2b5cef3..3815aafb 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -77,6 +77,7 @@ data PullRequest = PullRequest , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) + , pullRequestMergeableState :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -216,7 +217,7 @@ instance FromJSON PullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .: "body" + <*> o .:? "body" .!= "" -- TODO: no body is treated as empty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -235,6 +236,7 @@ instance FromJSON PullRequest where <*> o .: "commits" <*> o .: "merged" <*> o .:? "mergeable" + <*> o .: "mergeable_state" instance FromJSON PullRequestLinks where parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks From fe50307599377259aac71f187801b3f97a89d827 Mon Sep 17 00:00:00 2001 From: iphydf Date: Sun, 25 Sep 2016 22:01:35 +0100 Subject: [PATCH 029/309] Make body Maybe Text, add enum for mergeable_state. Also, renamed simpleIssueState in SimplePullRequest to simplePullRequestState. --- src/GitHub/Data/Options.hs | 26 ++++++++++++++++++++++++++ src/GitHub/Data/PullRequests.hs | 14 +++++++------- 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 285dec0e..d083dd16 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -44,6 +44,7 @@ module GitHub.Data.Options ( optionsNoAssignee, -- * Data IssueState (..), + MergeableState (..), -- * Internal HasState, HasDirection, @@ -86,6 +87,31 @@ instance FromJSON IssueState where instance NFData IssueState where rnf = genericRnf instance Binary IssueState +-- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state +data MergeableState + = StateUnknown + | StateClean + | StateDirty + | StateUnstable + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON MergeableState where + toJSON StateUnknown = String "unknown" + toJSON StateClean = String "clean" + toJSON StateDirty = String "dirty" + toJSON StateUnstable = String "unstable" + +instance FromJSON MergeableState where + parseJSON (String "unknown") = pure StateUnknown + parseJSON (String "clean") = pure StateClean + parseJSON (String "dirty") = pure StateDirty + parseJSON (String "unstable") = pure StateUnstable + parseJSON v = typeMismatch "MergeableState" v + +instance NFData MergeableState where rnf = genericRnf +instance Binary MergeableState + data SortDirection = SortAscending | SortDescending diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 3815aafb..9c7c7c78 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -19,7 +19,7 @@ module GitHub.Data.PullRequests ( import GitHub.Data.Definitions import GitHub.Data.Id (Id) -import GitHub.Data.Options (IssueState (..)) +import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) @@ -31,11 +31,11 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestCreatedAt :: !UTCTime , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL - , simpleIssueState :: !IssueState + , simplePullRequestState :: !IssueState , simplePullRequestNumber :: !Int , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime - , simplePullRequestBody :: !Text + , simplePullRequestBody :: !(Maybe Text) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -58,7 +58,7 @@ data PullRequest = PullRequest , pullRequestNumber :: !Int , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime - , pullRequestBody :: !Text + , pullRequestBody :: !(Maybe Text) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -77,7 +77,7 @@ data PullRequest = PullRequest , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) - , pullRequestMergeableState :: !Text + , pullRequestMergeableState :: !MergeableState } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -185,7 +185,7 @@ instance FromJSON SimplePullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .:? "body" .!= "" -- TODO: no body is treated as empty + <*> o .:? "body" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -217,7 +217,7 @@ instance FromJSON PullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .:? "body" .!= "" -- TODO: no body is treated as empty + <*> o .:? "body" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From bf5b6d9a90f6a7fbff47e4e1a9935cb6179898df Mon Sep 17 00:00:00 2001 From: Tristan Bull Date: Thu, 6 Oct 2016 12:10:46 -0500 Subject: [PATCH 030/309] Adding support for the 'Add or update team repository' github API. --- samples/Teams/Repos/AddOrUpdateTeamRepo.hs | 25 +++++++++++++++++++++ src/GitHub/Data/Request.hs | 6 ++++- src/GitHub/Data/Teams.hs | 15 +++++++++++++ src/GitHub/Endpoints/Organizations/Teams.hs | 15 +++++++++++++ src/GitHub/Request.hs | 1 + 5 files changed, 61 insertions(+), 1 deletion(-) create mode 100644 samples/Teams/Repos/AddOrUpdateTeamRepo.hs 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/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index f6481b60..5ca7556a 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -56,6 +56,7 @@ data CommandMethod a where Post :: CommandMethod a Patch :: CommandMethod a Put :: CommandMethod a + Put' :: CommandMethod () Delete :: CommandMethod () deriving (Typeable) @@ -65,18 +66,21 @@ instance Show (CommandMethod a) where showsPrec _ Post = showString "Post" showsPrec _ Patch = showString "Patch" showsPrec _ Put = showString "Put" + showsPrec _ Put' = showString "Put'" showsPrec _ Delete = showString "Delete" 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) + hashWithSalt salt Put' = hashWithSalt salt (3 :: Int) + hashWithSalt salt Delete = hashWithSalt salt (4 :: Int) toMethod :: CommandMethod a -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut +toMethod Put' = Method.methodPut toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 5df040c7..7e30a5fc 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -34,6 +34,13 @@ data Permission = instance NFData Permission where rnf = genericRnf instance Binary Permission +data AddTeamRepoPermission = AddTeamRepoPermission { + addTeamRepoPermission :: !Permission +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData AddTeamRepoPermission where rnf = genericRnf +instance Binary AddTeamRepoPermission + data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) ,simpleTeamUrl :: !URL @@ -178,6 +185,14 @@ instance ToJSON CreateTeamMembership where toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = object [ "role" .= role ] +instance FromJSON AddTeamRepoPermission where + parseJSON = withObject "AddTeamRepoPermission" $ \o -> + AddTeamRepoPermission <$> o .: "permission" + +instance ToJSON AddTeamRepoPermission where + toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = + object [ "permission" .= permission ] + instance FromJSON Role where parseJSON (String attr) = case attr of diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 0bdcf89c..04af873e 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -22,6 +22,8 @@ module GitHub.Endpoints.Organizations.Teams ( listTeamRepos, listTeamRepos', listTeamReposR, + addOrUpdateTeamRepo', + addOrUpdateTeamRepoR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, @@ -157,6 +159,19 @@ listTeamReposR tid = listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) listTeamRepos = listTeamRepos' Nothing +-- | Add a repository to a team or update the permission on the repository. +-- +-- > addOrUpdateTeamRepo' (OAuth "token") 1010101 "mburns" (Just PermissionPull) +addOrUpdateTeamRepo' :: Auth -> Id Team -> Name Organization -> Name Repo -> Permission -> IO (Either Error ()) +addOrUpdateTeamRepo' auth tid org repo permission = + executeRequest auth $ addOrUpdateTeamRepoR tid org repo permission + +-- | Add or update a team repository. +-- See +addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> Request 'RW () +addOrUpdateTeamRepoR tid org repo permission = + command Put' ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) + -- | Retrieve team mebership information for a user. -- With authentication -- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 75ecaf0f..5629e61c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -138,6 +138,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do res <- httpLbs' httpReq case m of Delete -> pure () + Put' -> pure () _ -> parseResponse res From 04e1cf8c3891dd161be65aec1e22bf3b019da649 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 14:42:03 +0200 Subject: [PATCH 031/309] Make it possible to not specify milestone or assignee --- src/GitHub/Data/Options.hs | 37 ++++++++++++++++++++++++++++--------- 1 file changed, 28 insertions(+), 9 deletions(-) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index d083dd16..ba27cdda 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -38,8 +38,10 @@ module GitHub.Data.Options ( -- * Repo issues IssueRepoMod, issueRepoModToQueryString, + optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, + optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, -- * Data @@ -161,6 +163,9 @@ data FilterBy a = FilterAny | FilterNone | FilterBy a + | FilterNotSpecified + -- ^ e.g. for milestones "any" means "any milestone". + -- I.e. won't show issues without mileston specified deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -491,9 +496,9 @@ data IssueRepoOptions = IssueRepoOptions defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions - { issueRepoOptionsMilestone = FilterAny + { issueRepoOptionsMilestone = FilterNotSpecified , issueRepoOptionsState = (Just StateOpen) - , issueRepoOptionsAssignee = FilterAny + , issueRepoOptionsAssignee = FilterNotSpecified , issueRepoOptionsCreator = Nothing , issueRepoOptionsMentioned = Nothing , issueRepoOptionsLabels = [] @@ -520,13 +525,13 @@ issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString issueRepoOptionsToQueryString IssueRepoOptions {..} = - [ mk "milestone" milestone' - , mk "assignee" assignee' - , mk "state" state' + [ mk "state" state' , mk "sort" sort' , mk "direction" direction' ] ++ catMaybes - [ mk "labels" <$> labels' + [ mk "milestone" <$> milestone' + , mk "assignee" <$> assignee' + , mk "labels" <$> labels' , mk "since" <$> since' , mk "creator" <$> creator' , mk "mentioned" <$> mentioned' @@ -534,9 +539,10 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = where mk k v = (k, Just v) filt f x = case x of - FilterAny -> "*" - FilterNone -> "none" - FilterBy x' -> TE.encodeUtf8 (f x') + 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 @@ -562,6 +568,15 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = -- Issues repo modifiers ------------------------------------------------------------------------------- +-- | Don't care about milestones. +-- +-- 'optionsAnyMilestone' means there should be some milestone, but it can be any. +-- +-- See +optionsIrrelevantMilestone :: IssueRepoMod +optionsIrrelevantMilestone = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterNotSpecified } + optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterAny } @@ -570,6 +585,10 @@ optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNone } +optionsIrrelevantAssignee :: IssueRepoMod +optionsIrrelevantAssignee = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterNotSpecified } + optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterAny } From 2299cebb0cf812bd3ddef5c69373bdd5f38741d2 Mon Sep 17 00:00:00 2001 From: "Gregory Mullen (grayhatter)" Date: Sun, 25 Sep 2016 17:28:07 -0700 Subject: [PATCH 032/309] Add assiginees to pull requests closes #248 --- src/GitHub/Data/Issues.hs | 3 ++- src/GitHub/Data/PullRequests.hs | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 7cb8d30f..c032e3c0 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -23,7 +23,7 @@ data Issue = Issue , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: (Vector IssueLabel) , issueNumber :: !Int - , issueAssignee :: !(Maybe SimpleUser) + , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text , issuePullRequest :: !(Maybe PullRequestReference) @@ -169,6 +169,7 @@ instance FromJSON Issue where <*> o .: "labels" <*> o .: "number" <*> o .:? "assignee" + <*> o .: "assignees" <*> o .: "user" <*> o .: "title" <*> o .:? "pull_request" diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 9c7c7c78..0a68ae0c 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -59,6 +59,7 @@ data PullRequest = PullRequest , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !(Maybe Text) + , pullRequestAssignees :: (Vector SimpleUser) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -218,6 +219,7 @@ instance FromJSON PullRequest where <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" + <*> o .: "assignees" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From 1a4afade306a466a22bff699b80757364aacfb39 Mon Sep 17 00:00:00 2001 From: "Gregory Mullen (grayhatter)" Date: Sun, 16 Oct 2016 01:43:54 -0700 Subject: [PATCH 033/309] add assignes to simplePull as well this alse includes the changes from @rob-b as well, thanks mate --- fixtures/issue-search.json | 2 ++ src/GitHub/Data/Issues.hs | 1 - src/GitHub/Data/PullRequests.hs | 2 ++ 3 files changed, 4 insertions(+), 1 deletion(-) 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/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index c032e3c0..6a433c48 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -168,7 +168,6 @@ instance FromJSON Issue where <*> o .:? "closed_by" <*> o .: "labels" <*> o .: "number" - <*> o .:? "assignee" <*> o .: "assignees" <*> o .: "user" <*> o .: "title" diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0a68ae0c..65f50f2f 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -36,6 +36,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !(Maybe Text) + , simplePullRequestAssignees :: (Vector SimpleUser) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -187,6 +188,7 @@ instance FromJSON SimplePullRequest where <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" + <*> o .: "assignees" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From f8851bfed62e1f16f9b030d93dc3a62e77502b5f Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:04:41 +0200 Subject: [PATCH 034/309] Add repository events (preliminary) --- github.cabal | 4 ++- src/GitHub.hs | 5 ++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/Definitions.hs | 2 -- src/GitHub/Data/Events.hs | 33 +++++++++++++++++++++++++ src/GitHub/Data/Issues.hs | 24 +++++++++--------- src/GitHub/Data/Name.hs | 18 +++++++++++++- src/GitHub/Data/Repos.hs | 2 +- src/GitHub/Endpoints/Activity/Events.hs | 21 ++++++++++++++++ src/GitHub/Endpoints/Issues/Events.hs | 18 +++++++------- 10 files changed, 103 insertions(+), 26 deletions(-) create mode 100644 src/GitHub/Data/Events.hs create mode 100644 src/GitHub/Endpoints/Activity/Events.hs diff --git a/github.cabal b/github.cabal index f5a99047..d83e07a7 100644 --- a/github.cabal +++ b/github.cabal @@ -72,12 +72,13 @@ Library GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Issues - GitHub.Data.Name GitHub.Data.Milestone + GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests GitHub.Data.Repos @@ -87,6 +88,7 @@ Library GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate + GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists diff --git a/src/GitHub.hs b/src/GitHub.hs index ce452a10..4d3187cb 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -15,6 +15,10 @@ module GitHub ( -- * Activity -- | See + -- ** Events + -- | See https://developer.github.com/v3/activity/events/#events + repositoryEventsR, + -- ** Starring -- | See -- @@ -306,6 +310,7 @@ module GitHub ( ) where import GitHub.Data +import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index c6cb79b3..f11aa450 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -36,6 +36,7 @@ module GitHub.Data ( module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, + module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, @@ -59,6 +60,7 @@ import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys +import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index c4a5c95d..c2c172d5 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -43,7 +43,6 @@ data SimpleUser = SimpleUser , simpleUserLogin :: !(Name User) , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL - , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -148,7 +147,6 @@ instance FromJSON SimpleUser where <*> obj .: "login" <*> obj .: "avatar_url" <*> obj .: "url" - <*> obj .: "type" instance FromJSON SimpleOrganization where parseJSON = withObject "SimpleOrganization" $ \obj -> diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs new file mode 100644 index 00000000..8ec6a22d --- /dev/null +++ b/src/GitHub/Data/Events.hs @@ -0,0 +1,33 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Events where + +import GitHub.Data.Definitions +import GitHub.Internal.Prelude +import Prelude () + +-- | Events. +-- +-- /TODO:/ +-- +-- * missing repo, org, payload, id +data Event = Event + -- { eventId :: !(Id Event) -- id can be encoded as string. + { eventActor :: !SimpleUser + , eventCreatedAt :: !UTCTime + , eventPublic :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Event where rnf = genericRnf +instance Binary Event + +instance FromJSON Event where + parseJSON = withObject "Event" $ \obj -> Event + -- <$> obj .: "id" + <$> obj .: "actor" + <*> obj .: "created_at" + <*> obj .: "public" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 6a433c48..e30a2c03 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -104,22 +104,22 @@ instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event -data Event = Event - { eventActor :: !SimpleUser - , eventType :: !EventType - , eventCommitId :: !(Maybe Text) - , eventUrl :: !URL - , eventCreatedAt :: !UTCTime - , eventId :: !Int - , eventIssue :: !(Maybe Issue) +data IssueEvent = IssueEvent + { issueEventActor :: !SimpleUser + , issueEventType :: !EventType + , issueEventCommitId :: !(Maybe Text) + , issueEventUrl :: !URL + , issueEventCreatedAt :: !UTCTime + , issueEventId :: !Int + , issueEventIssue :: !(Maybe Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Event where rnf = genericRnf -instance Binary Event +instance NFData IssueEvent where rnf = genericRnf +instance Binary IssueEvent -instance FromJSON Event where - parseJSON = withObject "Event" $ \o -> Event +instance FromJSON IssueEvent where + parseJSON = withObject "Event" $ \o -> IssueEvent <$> o .: "actor" <*> o .: "event" <*> o .:? "commit_id" diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 6f9fff53..35c12b0c 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -9,8 +10,13 @@ module GitHub.Data.Name ( untagName, ) where -import GitHub.Internal.Prelude import Prelude () +import GitHub.Internal.Prelude + +#if MIN_VERSION_aeson(1,0,0) +import Data.Aeson.Types + (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) +#endif newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -36,3 +42,13 @@ instance ToJSON (Name entity) where instance IsString (Name entity) where fromString = N . fromString + +#if MIN_VERSION_aeson(1,0,0) +-- | @since 0.15.0.0 +instance ToJSONKey (Name entity) where + toJSONKey = toJSONKeyText untagName + +-- | @since 0.15.0.0 +instance FromJSONKey (Name entity) where + fromJSONKey = fromJSONKeyCoerce +#endif diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 8e3c9343..9a079ca8 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -140,7 +140,7 @@ 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 -- JSON instances diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs new file mode 100644 index 00000000..60d7834a --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The events API as described on . +module GitHub.Endpoints.Activity.Events ( + -- * Events + repositoryEventsR, + 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"] [] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 9bc22a9b..97750eda 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -26,56 +26,56 @@ import Prelude () -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) +eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) +eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll -- | List events for an issue. -- See -eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector 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 :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" -eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event)) +eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo FetchAll -- | List events for a repository. -- See -eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector 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 :: Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- -- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 -event' :: Maybe Auth -> Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) +event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid -- | Query a single event. -- See -eventR :: Name Owner -> Name Repo -> Id 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", toPathPart eid] [] From 08cc0f0872cdd3238fc33b5f14ad178e2ed530b3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:09:17 +0200 Subject: [PATCH 035/309] Data.Repo formatting --- src/GitHub/Data/Repos.hs | 201 +++++++++++++++++++-------------------- 1 file changed, 100 insertions(+), 101 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 9a079ca8..cdd98ce9 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -27,37 +27,38 @@ import Unsafe.Coerce (unsafeCoerce) #endif #endif -data Repo = Repo { - repoSshUrl :: !(Maybe URL) - ,repoDescription :: !(Maybe Text) - ,repoCreatedAt :: !(Maybe UTCTime) - ,repoHtmlUrl :: !URL - ,repoSvnUrl :: !(Maybe URL) - ,repoForks :: !(Maybe Int) - ,repoHomepage :: !(Maybe Text) - ,repoFork :: !(Maybe Bool) - ,repoGitUrl :: !(Maybe URL) - ,repoPrivate :: !Bool - ,repoCloneUrl :: !(Maybe URL) - ,repoSize :: !(Maybe Int) - ,repoUpdatedAt :: !(Maybe UTCTime) - ,repoWatchers :: !(Maybe Int) - ,repoOwner :: !SimpleOwner - ,repoName :: !(Name Repo) - ,repoLanguage :: !(Maybe Language) - ,repoDefaultBranch :: !(Maybe Text) - ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories - ,repoId :: !(Id Repo) - ,repoUrl :: !URL - ,repoOpenIssues :: !(Maybe Int) - ,repoHasWiki :: !(Maybe Bool) - ,repoHasIssues :: !(Maybe Bool) - ,repoHasDownloads :: !(Maybe Bool) - ,repoParent :: !(Maybe RepoRef) - ,repoSource :: !(Maybe RepoRef) - ,repoHooksUrl :: !URL - ,repoStargazersCount :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Repo = Repo + { repoSshUrl :: !(Maybe URL) + , repoDescription :: !(Maybe Text) + , repoCreatedAt :: !(Maybe UTCTime) + , repoHtmlUrl :: !URL + , repoSvnUrl :: !(Maybe URL) + , repoForks :: !(Maybe Int) + , repoHomepage :: !(Maybe Text) + , repoFork :: !(Maybe Bool) + , repoGitUrl :: !(Maybe URL) + , repoPrivate :: !Bool + , repoCloneUrl :: !(Maybe URL) + , repoSize :: !(Maybe Int) + , repoUpdatedAt :: !(Maybe UTCTime) + , repoWatchers :: !(Maybe Int) + , repoOwner :: !SimpleOwner + , repoName :: !(Name Repo) + , repoLanguage :: !(Maybe Language) + , repoDefaultBranch :: !(Maybe Text) + , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , repoId :: !(Id Repo) + , repoUrl :: !URL + , repoOpenIssues :: !(Maybe Int) + , repoHasWiki :: !(Maybe Bool) + , repoHasIssues :: !(Maybe Bool) + , repoHasDownloads :: !(Maybe Bool) + , repoParent :: !(Maybe RepoRef) + , repoSource :: !(Maybe RepoRef) + , repoHooksUrl :: !URL + , repoStargazersCount :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance Binary Repo @@ -71,15 +72,15 @@ data RepoRef = RepoRef instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef -data NewRepo = NewRepo { - newRepoName :: !(Name Repo) -, newRepoDescription :: !(Maybe Text) -, newRepoHomepage :: !(Maybe Text) -, newRepoPrivate :: !(Maybe Bool) -, newRepoHasIssues :: !(Maybe Bool) -, newRepoHasWiki :: !(Maybe Bool) -, newRepoAutoInit :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Data, Typeable, Generic) +data NewRepo = NewRepo + { newRepoName :: !(Name Repo) + , newRepoDescription :: !(Maybe Text) + , newRepoHomepage :: !(Maybe Text) + , newRepoPrivate :: !(Maybe Bool) + , newRepoHasIssues :: !(Maybe Bool) + , newRepoHasWiki :: !(Maybe Bool) + , newRepoAutoInit :: !(Maybe Bool) + } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf instance Binary NewRepo @@ -87,15 +88,16 @@ 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) +data EditRepo = EditRepo + { editName :: !(Maybe (Name Repo)) + , editDescription :: !(Maybe Text) + , editHomepage :: !(Maybe Text) + , editPublic :: !(Maybe Bool) + , editHasIssues :: !(Maybe Bool) + , editHasWiki :: !(Maybe Bool) + , editHasDownloads :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData EditRepo where rnf = genericRnf instance Binary EditRepo @@ -127,12 +129,12 @@ instance IsString Language where fromString = Language . fromString data Contributor - -- | An existing Github user, with their number of contributions, avatar - -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text - -- | An unknown Github user with their number of contributions and recorded name. - | AnonymousContributor !Int !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + -- | An existing Github user, with their number of contributions, avatar + -- URL, login, URL, ID, and Gravatar ID. + = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text + -- | An unknown Github user with their number of contributions and recorded name. + | AnonymousContributor !Int !Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor where rnf = genericRnf instance Binary Contributor @@ -145,36 +147,35 @@ contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid -- 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 .:? "default_branch" - <*> o .:? "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .:? "open_issues" - <*> o .:? "has_wiki" - <*> o .:? "has_issues" - <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" + 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 .:? "default_branch" + <*> o .:? "pushed_at" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "open_issues" + <*> o .:? "has_wiki" + <*> o .:? "has_issues" + <*> o .:? "has_downloads" + <*> o .:? "parent" + <*> o .:? "source" + <*> o .: "hooks_url" + <*> o .: "stargazers_count" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name @@ -213,26 +214,24 @@ instance ToJSON EditRepo where ] 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) From 543e947ca07db114569508cc92afe6921740745b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:40:39 +0200 Subject: [PATCH 036/309] Some more re-formatting --- src/GitHub/Data/Teams.hs | 268 ++++++++++---------- src/GitHub/Endpoints/Repos/Collaborators.hs | 20 +- 2 files changed, 141 insertions(+), 147 deletions(-) diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 7e30a5fc..86ddfcfa 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -17,105 +17,111 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data Privacy = - PrivacyClosed - | PrivacySecret - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) +data Privacy + = PrivacyClosed + | PrivacySecret + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Privacy where rnf = genericRnf instance Binary Privacy -data Permission = - PermissionPull - | PermissionPush - | PermissionAdmin - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) +data Permission + = PermissionPull + | PermissionPush + | PermissionAdmin + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Permission where rnf = genericRnf instance Binary Permission -data AddTeamRepoPermission = AddTeamRepoPermission { - addTeamRepoPermission :: !Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data AddTeamRepoPermission = AddTeamRepoPermission + { addTeamRepoPermission :: !Permission + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData AddTeamRepoPermission where rnf = genericRnf instance Binary AddTeamRepoPermission -data SimpleTeam = SimpleTeam { - simpleTeamId :: !(Id Team) - ,simpleTeamUrl :: !URL - ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. - ,simpleTeamSlug :: !(Name Team) - ,simpleTeamDescription :: !(Maybe Text) - ,simpleTeamPrivacy :: !(Maybe Privacy) - ,simpleTeamPermission :: !Permission - ,simpleTeamMembersUrl :: !URL - ,simpleTeamRepositoriesUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data SimpleTeam = SimpleTeam + { simpleTeamId :: !(Id Team) + , simpleTeamUrl :: !URL + , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. + , simpleTeamSlug :: !(Name Team) + , simpleTeamDescription :: !(Maybe Text) + , simpleTeamPrivacy :: !(Maybe Privacy) + , simpleTeamPermission :: !Permission + , simpleTeamMembersUrl :: !URL + , simpleTeamRepositoriesUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf instance Binary SimpleTeam -data Team = Team { - teamId :: !(Id Team) - ,teamUrl :: !URL - ,teamName :: !Text - ,teamSlug :: !(Name Team) - ,teamDescription :: !(Maybe Text) - ,teamPrivacy :: !(Maybe Privacy) - ,teamPermission :: !Permission - ,teamMembersUrl :: !URL - ,teamRepositoriesUrl :: !URL - ,teamMembersCount :: !Int - ,teamReposCount :: !Int - ,teamOrganization :: !SimpleOrganization -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Team = Team + { teamId :: !(Id Team) + , teamUrl :: !URL + , teamName :: !Text + , teamSlug :: !(Name Team) + , teamDescription :: !(Maybe Text) + , teamPrivacy :: !(Maybe Privacy) + , teamPermission :: !Permission + , teamMembersUrl :: !URL + , teamRepositoriesUrl :: !URL + , teamMembersCount :: !Int + , teamReposCount :: !Int + , teamOrganization :: !SimpleOrganization + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf instance Binary Team -data CreateTeam = CreateTeam { - createTeamName :: !(Name Team) - ,createTeamDescription :: !(Maybe Text) - ,createTeamRepoNames :: !(Vector (Name Repo)) - {-,createTeamPrivacy :: Privacy-} - ,createTeamPermission :: Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data CreateTeam = CreateTeam + { createTeamName :: !(Name Team) + , createTeamDescription :: !(Maybe Text) + , createTeamRepoNames :: !(Vector (Name Repo)) + -- , createTeamPrivacy :: Privacy + , createTeamPermission :: Permission + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeam where rnf = genericRnf instance Binary CreateTeam -data EditTeam = EditTeam { - editTeamName :: !(Name Team) - ,editTeamDescription :: !(Maybe Text) - {-,editTeamPrivacy :: Privacy-} - ,editTeamPermission :: !Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditTeam = EditTeam + { editTeamName :: !(Name Team) + , editTeamDescription :: !(Maybe Text) + -- , editTeamPrivacy :: Privacy + , editTeamPermission :: !Permission + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam where rnf = genericRnf instance Binary EditTeam -data Role = - RoleMaintainer - | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Role + = RoleMaintainer + | RoleMember + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Role instance Binary Role -data ReqState = - StatePending - | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data ReqState + = StatePending + | StateActive + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ReqState where rnf = genericRnf instance Binary ReqState -data TeamMembership = TeamMembership { - teamMembershipUrl :: !URL, - teamMembershipRole :: !Role, - teamMembershipReqState :: !ReqState -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data TeamMembership = TeamMembership + { teamMembershipUrl :: !URL + , teamMembershipRole :: !Role + , teamMembershipReqState :: !ReqState + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData TeamMembership where rnf = genericRnf instance Binary TeamMembership @@ -130,31 +136,31 @@ 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" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" instance FromJSON Team where - parseJSON = withObject "Team" $ \o -> - Team <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" - <*> o .: "members_count" - <*> o .: "repos_count" - <*> o .: "organization" + parseJSON = withObject "Team" $ \o -> Team + <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + <*> o .: "members_count" + <*> o .: "repos_count" + <*> o .: "organization" instance ToJSON CreateTeam where toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = @@ -172,82 +178,68 @@ instance ToJSON EditTeam where , "permissions" .= permissions ] 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" + parseJSON = withObject "AddTeamRepoPermission" $ \o -> AddTeamRepoPermission + <$> o .: "permission" instance ToJSON AddTeamRepoPermission where - toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = - object [ "permission" .= permission ] + 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 "Attribute" $ \attr -> case attr of + "maintainer" -> return RoleMaintainer + "member" -> return RoleMember + _ -> fail $ "Unknown Role: " ++ show attr instance ToJSON Role where - toJSON RoleMaintainer = String "maintainer" - toJSON RoleMember = String "member" + 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 PermissionPull = "pull" + toJSON PermissionPush = "push" + toJSON PermissionAdmin = "admin" 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 Attribute" $ \attr -> case attr of + "pull" -> return PermissionPull + "push" -> return PermissionPush + "admin" -> return PermissionAdmin + _ -> fail $ "Unknown Permission Attribute: " ++ show attr instance FromJSON Privacy where - parseJSON (String attr) = - case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail "Unknown Privacy Attribute" - parseJSON _ = fail "Could not build Privacy" + parseJSON = withText "Privacy Attribute" $ \attr -> case attr of + "secret" -> return PrivacySecret + "closed" -> return PrivacyClosed + _ -> fail $ "Unknown Privacy Attribute: " ++ show attr 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" $ \attr -> case attr of + "active" -> return StateActive + "pending" -> return StatePending + _ -> fail $ "Unknown ReqState: " ++ show attr 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 diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 1504ca0f..d3049d7b 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -42,19 +42,21 @@ collaboratorsOnR user repo = -- -- > 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 + :: Maybe Auth + -> Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator? + -> IO (Either Error Bool) isCollaboratorOn auth user repo coll = executeRequestMaybe auth $ isCollaboratorOnR user repo coll -- | Check if a user is a collaborator. -- See -isCollaboratorOnR :: Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator? - -> Request k Bool +isCollaboratorOnR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator? + -> Request k Bool isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] From 39dc3780a631459adbaf0d03beab6eef7f0089de Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:40:44 +0200 Subject: [PATCH 037/309] Update changelog --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 657d186e..1941a252 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,12 @@ Changes for 0.15.0 - Add 'organizationIssuesR' - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` - Refactor 'Request' structure +- Added multiple issue assignees +- Preliminary support for repository events: `repositoryEventsR` +- Support for adding repository permissions to the team +- Remove 'simpleUserType', it was always the same. + +See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) Changes for 0.14.1 From b0e558cb1c504b8f4488e1673b3cf8c5b0334a0b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 18:07:58 +0200 Subject: [PATCH 038/309] Update travis jobs --- .travis.yml | 21 +++++++++------------ stack-lts-5.yaml | 3 ++- stack-lts-6.yaml | 6 ++++++ stack-lts-7.yaml | 6 ++++++ stack.yaml | 2 +- 5 files changed, 24 insertions(+), 14 deletions(-) create mode 100644 stack-lts-6.yaml create mode 100644 stack-lts-7.yaml diff --git a/.travis.yml b/.travis.yml index a6c2ed92..17bb8048 100644 --- a/.travis.yml +++ b/.travis.yml @@ -27,18 +27,7 @@ matrix: - 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]}} @@ -51,12 +40,20 @@ matrix: - 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-lts-6.yaml GHCVER=7.10.3 + compiler: ": #STACK LTS6" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-7.yaml GHCVER=7.10.3 + compiler: ": #STACK LTS7" + addons: {apt: {packages: [ghc-8.0.1], 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 + - env: BUILD=stack-space-leak compiler: ": #STACK - space leak" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 591b123f..f09cb78c 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -2,4 +2,5 @@ resolver: lts-5.18 packages: - '.' - samples/ -extra-deps: [] +extra-deps: +- hsc2hs-0.68 diff --git a/stack-lts-6.yaml b/stack-lts-6.yaml new file mode 100644 index 00000000..119a9b1d --- /dev/null +++ b/stack-lts-6.yaml @@ -0,0 +1,6 @@ +resolver: lts-6.23 +packages: +- '.' +- samples/ +extra-deps: +- hsc2hs-0.68 diff --git a/stack-lts-7.yaml b/stack-lts-7.yaml new file mode 100644 index 00000000..48ba555a --- /dev/null +++ b/stack-lts-7.yaml @@ -0,0 +1,6 @@ +resolver: lts-7.7 +packages: +- '.' +- samples/ +extra-deps: +- hsc2hs-0.68 diff --git a/stack.yaml b/stack.yaml index 0db6065a..50e2a08c 120000 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -stack-lts-5.yaml \ No newline at end of file +stack-lts-7.yaml \ No newline at end of file From 8d0e12481b79ed8d043b5d109525974f7f2fdd79 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 1 Jan 2017 23:08:26 +0200 Subject: [PATCH 039/309] Allow aeson-1.1 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index d83e07a7..b4c6eb2e 100644 --- a/github.cabal +++ b/github.cabal @@ -121,7 +121,7 @@ Library -- Packages needed in order to build this package. build-depends: base >=4.7 && <4.10, - aeson >=0.7.0.6 && <1.1, + aeson >=0.7.0.6 && <1.2, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, From a81266bce4a7644c214ce40afd9c61e5a8324480 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 2 Jan 2017 07:31:17 +0200 Subject: [PATCH 040/309] 0.15.0~1 [ci skip] --- github.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/github.cabal b/github.cabal index b4c6eb2e..a43caba4 100644 --- a/github.cabal +++ b/github.cabal @@ -1,4 +1,5 @@ name: github +x-revision: 1 version: 0.15.0 synopsis: Access to the GitHub API, v3. description: From 43e765e2cb49e2efeb00dca5ad2366abfedf892a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 9 Jan 2017 11:32:17 +0200 Subject: [PATCH 041/309] Allow vector-0.12 and vector-instances-3.4 --- github.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/github.cabal b/github.cabal index a43caba4..e94a03fb 100644 --- a/github.cabal +++ b/github.cabal @@ -148,8 +148,8 @@ Library 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, + vector >=0.10.12.3 && <0.13, + vector-instances >=3.3.0.1 && <3.5, tls >=1.3.5 From 8065c1da2507d5ca62a04dafe2f05987f288e6f8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 9 Jan 2017 14:52:33 +0200 Subject: [PATCH 042/309] Add dist-newstyle to .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index e22e77ba..7a8fb579 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ dist +dist-newstyle *swp .cabal-sandbox cabal.sandbox.config From 0cdb50bbb73303d62ed0463281c39edc66a296c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 9 Jan 2017 14:53:11 +0200 Subject: [PATCH 043/309] Revision 0.15.0~2 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index e94a03fb..5d84cb89 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -x-revision: 1 +x-revision: 2 version: 0.15.0 synopsis: Access to the GitHub API, v3. description: From 2a3bf846b7429eb14f2055a76d54cde9392d5079 Mon Sep 17 00:00:00 2001 From: Abhinav Gupta Date: Wed, 25 Jan 2017 00:04:41 -0800 Subject: [PATCH 044/309] pulls: Update base and maintainer_can_modify GitHub added support for changing the base branch for a pull request and whether the maintainer can modify its contents or not. This adds the same to the `updatePullRequest` API. --- samples/Pulls/UpdatePull.hs | 8 +++++++- src/GitHub/Data/PullRequests.hs | 14 ++++++++++++-- 2 files changed, 19 insertions(+), 3 deletions(-) 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/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 65f50f2f..c8ae83d3 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -90,6 +90,9 @@ data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) , editPullRequestState :: !(Maybe IssueState) + , editPullRequestBase :: !(Maybe Text) + , editPullRequestMaintainerCanModify + :: !(Maybe Bool) } deriving (Show, Generic) @@ -198,8 +201,15 @@ instance FromJSON SimplePullRequest where <*> o .: "id" 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 From bb5b62363ebbf9baa36373f42f4e2a51e7862e2f Mon Sep 17 00:00:00 2001 From: NooB Date: Fri, 10 Feb 2017 16:49:50 +0900 Subject: [PATCH 045/309] Fix HTTP status code of merge PR --- src/GitHub/Data/PullRequests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index c8ae83d3..d5148d87 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -309,7 +309,7 @@ data MergeResult statusMerge :: StatusMap MergeResult statusMerge = - [ (204, MergeSuccessful) + [ (200, MergeSuccessful) , (405, MergeCannotPerform) , (409, MergeConflict) ] From 3d3e3c1d7b80d11154bcba7c64e89e118be2e368 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Feb 2017 16:25:22 -0400 Subject: [PATCH 046/309] add back pullRequestsFor' Closes #266 --- src/GitHub/Endpoints/PullRequests.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index edb66509..bfea41c9 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -7,6 +7,7 @@ -- . module GitHub.Endpoints.PullRequests ( pullRequestsFor, + pullRequestsFor', pullRequestsForR, pullRequest', pullRequest, @@ -40,6 +41,13 @@ pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePul pullRequestsFor user repo = executeRequest' $ pullRequestsForR user repo mempty FetchAll +-- | All open pull requests for the repo, by owner and repo name. +-- +-- > pullRequestsFor "rails" "rails" +pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) +pullRequestsFor' auth user repo = + executeRequestMaybe auth $ pullRequestsForR user repo mempty FetchAll + -- | List pull requests. -- See pullRequestsForR From 37a610a93a3f6261ea4de3a827abfb751574cb9c Mon Sep 17 00:00:00 2001 From: iphydf Date: Sat, 25 Mar 2017 15:53:27 +0000 Subject: [PATCH 047/309] Add support for mergeable_state = "blocked". Fixes #269. --- src/GitHub/Data/Options.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index ba27cdda..274d4b2a 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -95,6 +95,7 @@ data MergeableState | StateClean | StateDirty | StateUnstable + | StateBlocked deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -103,13 +104,15 @@ instance ToJSON MergeableState where toJSON StateClean = String "clean" toJSON StateDirty = String "dirty" toJSON StateUnstable = String "unstable" + toJSON StateBlocked = String "blocked" instance FromJSON MergeableState where parseJSON (String "unknown") = pure StateUnknown parseJSON (String "clean") = pure StateClean parseJSON (String "dirty") = pure StateDirty parseJSON (String "unstable") = pure StateUnstable - parseJSON v = typeMismatch "MergeableState" v + parseJSON (String "blocked") = pure StateBlocked + parseJSON v = typeMismatch "MergeableState" v instance NFData MergeableState where rnf = genericRnf instance Binary MergeableState From e82c6070beb687078f17222e2722ddfb5f79cd4b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 17 Apr 2017 14:45:39 +0300 Subject: [PATCH 048/309] Allow aeson-1.2 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 5d84cb89..75c11fca 100644 --- a/github.cabal +++ b/github.cabal @@ -122,7 +122,7 @@ Library -- Packages needed in order to build this package. build-depends: base >=4.7 && <4.10, - aeson >=0.7.0.6 && <1.2, + aeson >=0.7.0.6 && <1.3, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, From 1796b736b7135326ef6fd6cc67a2c2aed45e729f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?F=C3=A9lix=20Baylac-Jacqu=C3=A9?= Date: Tue, 25 Apr 2017 13:29:42 +0200 Subject: [PATCH 049/309] Add support for user public events. Fix issue #273 --- github.cabal | 1 + spec/GitHub/EventsSpec.hs | 36 +++++++++++++++++++++++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Activity/Events.hs | 7 +++++ 4 files changed, 45 insertions(+), 1 deletion(-) create mode 100644 spec/GitHub/EventsSpec.hs diff --git a/github.cabal b/github.cabal index 75c11fca..11d8b038 100644 --- a/github.cabal +++ b/github.cabal @@ -173,6 +173,7 @@ test-suite github-test GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec + GitHub.EventsSpec main-is: Spec.hs ghc-options: -Wall build-depends: base, diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs new file mode 100644 index 00000000..93f613b1 --- /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 "phadej" "github" 1 + describe "userEventsR" $ do + it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 + where shouldSucceed f = withAuth $ \auth -> do + cs <- GitHub.executeRequest auth $ f + cs `shouldSatisfy` isRight + length (fromRightS cs) `shouldSatisfy` (> 1) diff --git a/src/GitHub.hs b/src/GitHub.hs index 4d3187cb..f4528018 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -18,7 +18,7 @@ module GitHub ( -- ** Events -- | See https://developer.github.com/v3/activity/events/#events repositoryEventsR, - + userEventsR, -- ** Starring -- | See -- diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs index 60d7834a..8074ab2a 100644 --- a/src/GitHub/Endpoints/Activity/Events.hs +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -7,6 +7,7 @@ module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, + userEventsR, module GitHub.Data, ) where @@ -19,3 +20,9 @@ import Prelude () 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"] [] From 4b2c2b556636e792a84579f4c8ae6fb1a33fffa2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 4 Jun 2017 01:34:40 +0300 Subject: [PATCH 050/309] Prepare for 0.16.0 --- .gitignore | 1 + .travis.yml | 128 ++++++++++++++++++++++++++------------------- CHANGELOG.md | 5 ++ cabal.project | 3 ++ github.cabal | 11 ++-- stack-ghc-8.0.yaml | 101 ----------------------------------- stack-lts-2.yaml | 25 --------- stack-lts-3.yaml | 14 ----- stack-lts-4.yaml | 8 --- stack-lts-5.yaml | 6 --- stack-lts-6.yaml | 6 --- stack-lts-7.yaml | 6 --- stack-nightly.yaml | 11 ---- stack.yaml | 1 - travis-install.sh | 56 -------------------- travis-script.sh | 44 ---------------- 16 files changed, 88 insertions(+), 338 deletions(-) create mode 100644 cabal.project delete mode 100644 stack-ghc-8.0.yaml delete mode 100644 stack-lts-2.yaml delete mode 100644 stack-lts-3.yaml delete mode 100644 stack-lts-4.yaml delete mode 100644 stack-lts-5.yaml delete mode 100644 stack-lts-6.yaml delete mode 100644 stack-lts-7.yaml delete mode 100644 stack-nightly.yaml delete mode 120000 stack.yaml delete mode 100644 travis-install.sh delete mode 100644 travis-script.sh diff --git a/.gitignore b/.gitignore index 7a8fb579..5b3e088e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ dist dist-newstyle +.ghc.environment.* *swp .cabal-sandbox cabal.sandbox.config diff --git a/.travis.yml b/.travis.yml index 17bb8048..34f8cfd6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,77 +1,97 @@ -# This file has been generated -- see https://github.com/hvr/multi-ghc-travis +# This Travis job script has been generated by a script via +# +# make_travis_yml_2.hs 'github.cabal' +# +# For more information, see https://github.com/hvr/multi-ghc-travis +# language: c sudo: false +git: + submodules: false # whether to recursively clone submodules + cache: directories: - - $HOME/.cabsnap - $HOME/.cabal/packages - - $HOME/.stack + - $HOME/.cabal/store 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=" + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx 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=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-lts-6.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS6" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-7.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS7" - addons: {apt: {packages: [ghc-8.0.1], 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 - - - env: BUILD=stack-space-leak - compiler: ": #STACK - space leak" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-7.8.4" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} + - compiler: "ghc-7.10.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-8.0.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.1" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} before_install: - - unset CC - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:$PATH + - HC=${CC} + - unset CC + - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - PKGNAME='github' install: - - sh travis-install.sh + - ROOTDIR=$(pwd) + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - "echo 'packages: .' > cabal.project" + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all # 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 + - if [ -f configure.ac ]; then autoreconf -i; fi + - rm -rf .ghc.environment.* dist/ + - cabal sdist # test that a source-distribution can be generated + - cd dist/ + - SRCTAR=(${PKGNAME}-*.tar.gz) + - SRC_BASENAME="${SRCTAR/%.tar.gz}" + - tar -xvf "./$SRC_BASENAME.tar.gz" + - cd "$SRC_BASENAME/" +## from here on, CWD is inside the extracted source-tarball + - rm -fv cabal.project.local + - "echo 'packages: . samples' > cabal.project" + - cp -r $ROOTDIR/samples . + # this builds all libraries and executables (without tests/benchmarks) + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + # this builds all libraries and executables (including tests/benchmarks) + # - rm -rf ./dist-newstyle -branches: - only: - - master + # build & run tests + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + + # run samples + - for sample in show-user list-followers list-following operational; do + echo "=== SAMPLE $sample ==="; + $(find dist-newstyle/ -type -f -name github-$sample); + done # EOF + +branches: + only: + - master diff --git a/CHANGELOG.md b/CHANGELOG.md index 1941a252..7acdf273 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +Changes for 0.16.0 +- Add support for `mergeable_state = "blocked".` +- Fix HTTP status code of merge PR +- Supports newest versions of dependencies + Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) diff --git a/cabal.project b/cabal.project new file mode 100644 index 00000000..7625ac15 --- /dev/null +++ b/cabal.project @@ -0,0 +1,3 @@ +packages: + "." + samples diff --git a/github.cabal b/github.cabal index 11d8b038..600c171c 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github -x-revision: 2 -version: 0.15.0 +version: 0.16.0 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -26,7 +25,7 @@ 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 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -121,11 +120,11 @@ Library GitHub.Request -- Packages needed in order to build this package. - build-depends: base >=4.7 && <4.10, + build-depends: base >=4.7 && <4.11, aeson >=0.7.0.6 && <1.3, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.9, + binary >=0.7.1.0 && <0.10, binary-orphans >=0.1.0.0 && <0.2, byteable >=0.1.1 && <0.2, bytestring >=0.10.4.0 && <0.11, @@ -144,7 +143,7 @@ Library 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, + time >=1.4 && <1.9, transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, diff --git a/stack-ghc-8.0.yaml b/stack-ghc-8.0.yaml deleted file mode 100644 index 90f9616d..00000000 --- a/stack-ghc-8.0.yaml +++ /dev/null @@ -1,101 +0,0 @@ -resolver: ghc-8.0.1 -packages: -- '.' -extra-deps: -- 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 -- HUnit-1.3.1.1 -- 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-2.8.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 -- StateVar-1.1.0.4 -- 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 -flags: - time-locale-compat: - old-locale: false diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml deleted file mode 100644 index d909cd7e..00000000 --- a/stack-lts-2.yaml +++ /dev/null @@ -1,25 +0,0 @@ -resolver: lts-2.22 -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 -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 5162f85f..00000000 --- a/stack-lts-3.yaml +++ /dev/null @@ -1,14 +0,0 @@ -resolver: lts-3.22 -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 -flags: - github: - aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml deleted file mode 100644 index ab1937e3..00000000 --- a/stack-lts-4.yaml +++ /dev/null @@ -1,8 +0,0 @@ -resolver: lts-4.2 -packages: -- '.' -- samples/ -extra-deps: -- base-compat-0.9.1 -- cryptonite-0.15 -- tls-1.3.8 diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml deleted file mode 100644 index f09cb78c..00000000 --- a/stack-lts-5.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-5.18 -packages: -- '.' -- samples/ -extra-deps: -- hsc2hs-0.68 diff --git a/stack-lts-6.yaml b/stack-lts-6.yaml deleted file mode 100644 index 119a9b1d..00000000 --- a/stack-lts-6.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-6.23 -packages: -- '.' -- samples/ -extra-deps: -- hsc2hs-0.68 diff --git a/stack-lts-7.yaml b/stack-lts-7.yaml deleted file mode 100644 index 48ba555a..00000000 --- a/stack-lts-7.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-7.7 -packages: -- '.' -- samples/ -extra-deps: -- hsc2hs-0.68 diff --git a/stack-nightly.yaml b/stack-nightly.yaml deleted file mode 100644 index 0511b9a1..00000000 --- a/stack-nightly.yaml +++ /dev/null @@ -1,11 +0,0 @@ -resolver: nightly-2016-09-14 -packages: -- '.' -- 'samples/' -extra-deps: -- aeson-1.0.0.0 -- http-client-0.5.3.1 -- http-client-tls-0.3.1 -flags: - github: - aeson-compat: true diff --git a/stack.yaml b/stack.yaml deleted file mode 120000 index 50e2a08c..00000000 --- a/stack.yaml +++ /dev/null @@ -1 +0,0 @@ -stack-lts-7.yaml \ No newline at end of file diff --git a/travis-install.sh b/travis-install.sh deleted file mode 100644 index 61fc1fd6..00000000 --- a/travis-install.sh +++ /dev/null @@ -1,56 +0,0 @@ -set -ex - -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 - - if [ $BUILD == "stack-space-leak" ]; then - stack build --test --fast --library-profiling --ghc-options=-rtsopts --only-dependencies - else - stack --no-terminal test --only-dependencies - fi - ;; - 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 --constraint="integer-simple installed" --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 --constraint="integer-simple installed" --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 ef51e715..00000000 --- a/travis-script.sh +++ /dev/null @@ -1,44 +0,0 @@ -set -ex - -SAMPLE_EXES="show-user list-followers list-following operational" - -case $BUILD in - stack) - stack --no-terminal test github - stack --no-terminal build github-samples - - for testbin in $SAMPLE_EXES; do - echo "Running " $testbin - stack exec github-$testbin - done - ;; - stack-space-leak) - stack --no-terminal test --fast --library-profiling --ghc-options=-rtsopts --test-arguments='+RTS -K1K' github - stack --no-terminal build --fast --library-profiling --ghc-options=-rtsopts --executable-profiling --test-arguments='+RTS -K1K' github-samples - - for testbin in $SAMPLE_EXES; do - echo "Running " $testbin - stack exec github-$testbin - done - ;; - cabal) - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --constraint="integer-simple installed" --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 From 5a2785c2c51a941d57a8e067cfa8c5cff61bc3d1 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 28 Jun 2017 13:00:11 +0300 Subject: [PATCH 051/309] Correct github-samples.cabal --- samples/github-samples.cabal | 88 ---------------------------- samples/package.yaml | 108 ----------------------------------- 2 files changed, 196 deletions(-) delete mode 100644 samples/package.yaml diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 228575c9..826c3e1e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,7 +1,3 @@ --- This file has been generated from package.yaml by hpack version 0.14.1. --- --- see: https://github.com/sol/hpack - name: github-samples version: 0.0.0 build-type: Simple @@ -31,9 +27,6 @@ executable github-add-team-membership-for , github , text , github-samples - other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor default-language: Haskell2010 executable github-create-deploy-key @@ -47,10 +40,6 @@ executable github-create-deploy-key , github , text , github-samples - other-modules: - DeleteDeployKey - ListDeployKeys - ShowDeployKey default-language: Haskell2010 executable github-delete-deploy-key @@ -64,10 +53,6 @@ executable github-delete-deploy-key , github , text , github-samples - other-modules: - CreateDeployKey - ListDeployKeys - ShowDeployKey default-language: Haskell2010 executable github-delete-team @@ -81,14 +66,6 @@ executable github-delete-team , github , text , github-samples - other-modules: - EditTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-delete-team-membership-for @@ -102,9 +79,6 @@ executable github-delete-team-membership-for , github , text , github-samples - other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor default-language: Haskell2010 executable github-edit-team @@ -118,14 +92,6 @@ executable github-edit-team , github , text , github-samples - other-modules: - DeleteTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-list-deploy-keys-for @@ -140,10 +106,6 @@ executable github-list-deploy-keys-for , text , github-samples , vector - other-modules: - CreateDeployKey - DeleteDeployKey - ShowDeployKey default-language: Haskell2010 executable github-list-followers @@ -157,9 +119,6 @@ executable github-list-followers , github , text , github-samples - other-modules: - Example - ListFollowing default-language: Haskell2010 executable github-list-followers-example @@ -172,9 +131,6 @@ executable github-list-followers-example , base-compat , github , text - other-modules: - ListFollowers - ListFollowing default-language: Haskell2010 executable github-list-following @@ -188,9 +144,6 @@ executable github-list-following , github , text , github-samples - other-modules: - Example - ListFollowers default-language: Haskell2010 executable github-list-team-current @@ -204,14 +157,6 @@ executable github-list-team-current , github , text , github-samples - other-modules: - DeleteTeam - EditTeam - ListRepos - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-list-team-repos @@ -225,14 +170,6 @@ executable github-list-team-repos , github , text , github-samples - other-modules: - DeleteTeam - EditTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-operational @@ -264,10 +201,6 @@ executable github-show-deploy-key , github , text , github-samples - other-modules: - CreateDeployKey - DeleteDeployKey - ListDeployKeys default-language: Haskell2010 executable github-show-user @@ -281,11 +214,6 @@ executable github-show-user , github , text , github-samples - other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 default-language: Haskell2010 executable github-show-user-2 @@ -299,11 +227,6 @@ executable github-show-user-2 , github , text , github-samples - other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser default-language: Haskell2010 executable github-team-membership-info-for @@ -317,9 +240,6 @@ executable github-team-membership-info-for , github , text , github-samples - other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor default-language: Haskell2010 executable github-teaminfo-for @@ -333,12 +253,4 @@ executable github-teaminfo-for , github , text , github-samples - other-modules: - DeleteTeam - EditTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor default-language: Haskell2010 diff --git a/samples/package.yaml b/samples/package.yaml deleted file mode 100644 index eae199e7..00000000 --- a/samples/package.yaml +++ /dev/null @@ -1,108 +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 - github-list-deploy-keys-for: - main: ListDeployKeys.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples - - vector - github-show-deploy-key: - main: ShowDeployKey.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples - github-create-deploy-key: - main: CreateDeployKey.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples - github-delete-deploy-key: - main: DeleteDeployKey.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples From 4e745b32fd27d157a880e7d2c073201bd78f6658 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 28 Jun 2017 16:33:11 +0300 Subject: [PATCH 052/309] Try to install hspec-discover --- .travis.yml | 2 ++ install-hspec-discover.sh | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 install-hspec-discover.sh diff --git a/.travis.yml b/.travis.yml index 34f8cfd6..ed58cfcd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,6 +14,7 @@ cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store + - $HOME/.local/bin before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log @@ -53,6 +54,7 @@ install: - TEST=${TEST---enable-tests} - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - sh install-hspec-discover.sh # TEMP, before we get cabal new-install - rm -fv cabal.project.local - "echo 'packages: .' > cabal.project" - rm -f cabal.project.freeze diff --git a/install-hspec-discover.sh b/install-hspec-discover.sh new file mode 100644 index 00000000..17a3a34a --- /dev/null +++ b/install-hspec-discover.sh @@ -0,0 +1,18 @@ +#!/bin/sh + +set -ex + +if [ ! -e $HOME/.local/bin/hspec-discover ]; then + # Fetch the source + cabal get hspec-discover-2.4.4 + cd hspec-discover-2.4.4 + + # Set-up project + echo 'packages: .' > cabal.project + + # build exe + cabal new-build hspec-discover:exe:hspec-discover + + # copy executable to $HOME/.local/bin + cp $(find dist-newstyle -name hspec-discover -type f) $HOME/.local/bin +fi From f837951a48dee4b98af09084ba1f72e05248c686 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 28 Jun 2017 23:54:03 +0300 Subject: [PATCH 053/309] -type -f -> -type f --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index ed58cfcd..82db014c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -89,7 +89,7 @@ script: # run samples - for sample in show-user list-followers list-following operational; do echo "=== SAMPLE $sample ==="; - $(find dist-newstyle/ -type -f -name github-$sample); + $(find dist-newstyle/ -type f -name github-$sample); done # EOF From b593ddb5ab177e9fd2d4ccad1958c04de14993dd Mon Sep 17 00:00:00 2001 From: Kranium Gikos Mendoza Date: Sun, 18 Jun 2017 22:31:51 +1000 Subject: [PATCH 054/309] implement read-only calls for releases endpoint --- github.cabal | 5 +- spec/GitHub/ReleasesSpec.hs | 54 ++++++++++++ src/GitHub.hs | 7 ++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Releases.hs | 85 +++++++++++++++++++ src/GitHub/Endpoints/Repos/Releases.hs | 110 +++++++++++++++++++++++++ 6 files changed, 262 insertions(+), 1 deletion(-) create mode 100644 spec/GitHub/ReleasesSpec.hs create mode 100644 src/GitHub/Data/Releases.hs create mode 100644 src/GitHub/Endpoints/Repos/Releases.hs diff --git a/github.cabal b/github.cabal index 600c171c..e67d0ab6 100644 --- a/github.cabal +++ b/github.cabal @@ -81,6 +81,7 @@ Library GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests + GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Search @@ -111,9 +112,10 @@ Library GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits + GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks + GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Webhooks - GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Followers @@ -169,6 +171,7 @@ test-suite github-test GitHub.OrganizationsSpec GitHub.IssuesSpec GitHub.PullRequestsSpec + GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec diff --git a/spec/GitHub/ReleasesSpec.hs b/spec/GitHub/ReleasesSpec.hs new file mode 100644 index 00000000..db01348f --- /dev/null +++ b/spec/GitHub/ReleasesSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.ReleasesSpec where + +import qualified GitHub + +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Repos.Releases + (Release (..), latestReleaseR, releaseByTagNameR, releaseR, releasesR) +import GitHub.Request (executeRequest) + +import Data.Either.Compat (isRight) +import Data.Proxy (Proxy (..)) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + let v154Id = GitHub.mkId (Proxy :: Proxy Release) 5254449 + v154Text = "v1.5.4" + describe "releasesR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releasesR "calleerlandsson" "pick" GitHub.FetchAll + rs `shouldSatisfy` isRight + V.length (fromRightS rs) `shouldSatisfy` (> 14) + describe "releaseR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releaseR "calleerlandsson" "pick" v154Id + rs `shouldSatisfy` isRight + releaseTagName (fromRightS rs)`shouldBe` v154Text + describe "latestReleaseR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ latestReleaseR "calleerlandsson" "pick" + rs `shouldSatisfy` isRight + describe "releaseByTagNameR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releaseByTagNameR "calleerlandsson" "pick" v154Text + rs `shouldSatisfy` isRight + releaseId (fromRightS rs)`shouldBe` v154Id diff --git a/src/GitHub.hs b/src/GitHub.hs index f4528018..e45282e6 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -270,6 +270,12 @@ module GitHub ( pingRepoWebhookR, deleteRepoWebhookR, + -- * Releases + releasesR, + releaseR, + latestReleaseR, + releaseByTagNameR, + -- * Search -- | See -- @@ -334,6 +340,7 @@ import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Forks +import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index f11aa450..e318313f 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -43,6 +43,7 @@ module GitHub.Data ( module GitHub.Data.Milestone, module GitHub.Data.Options, module GitHub.Data.PullRequests, + module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Search, @@ -69,6 +70,7 @@ import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options import GitHub.Data.PullRequests +import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Search diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs new file mode 100644 index 00000000..582b524c --- /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, Typeable, Eq, Ord, Generic) + +instance FromJSON Release where + parseJSON = withObject "Event" $ \o -> Release + <$> o .: "url" + <*> o .: "html_url" + <*> o .: "assets_url" + <*> o .: "upload_url" + <*> o .: "tarball_url" + <*> o .: "zipball_url" + <*> o .: "id" + <*> o .: "tag_name" + <*> o .: "target_commitish" + <*> o .: "name" + <*> o .: "body" + <*> o .: "draft" + <*> o .: "prerelease" + <*> o .: "created_at" + <*> o .:? "published_at" + <*> o .: "author" + <*> o .: "assets" + +instance NFData Release where rnf = genericRnf +instance Binary Release + +data ReleaseAsset = ReleaseAsset + { releaseAssetUrl :: !URL + , releaseAssetBrowserDownloadUrl :: !Text + , releaseAssetId :: !(Id ReleaseAsset) + , releaseAssetName :: !Text + , releaseAssetLabel :: !(Maybe Text) + , releaseAssetState :: !Text + , releaseAssetContentType :: !Text + , releaseAssetSize :: !Int + , releaseAssetDownloadCount :: !Int + , releaseAssetCreatedAt :: !UTCTime + , releaseAssetUpdatedAt :: !UTCTime + , releaseAssetUploader :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON ReleaseAsset where + parseJSON = withObject "Event" $ \o -> ReleaseAsset + <$> o .: "url" + <*> o .: "browser_download_url" + <*> o .: "id" + <*> o .: "name" + <*> o .:? "label" + <*> o .: "state" + <*> o .: "content_type" + <*> o .: "size" + <*> o .: "download_count" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "uploader" + +instance NFData ReleaseAsset where rnf = genericRnf +instance Binary ReleaseAsset diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs new file mode 100644 index 00000000..462060f4 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -0,0 +1,110 @@ +-- The Release API, as described at +-- . +module GitHub.Endpoints.Repos.Releases ( + releases, + releases', + releasesR, + release, + release', + releaseR, + latestRelease, + latestRelease', + latestReleaseR, + releaseByTagName, + releaseByTagName', + releaseByTagNameR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | All releases for the given repo. +-- +-- > releases "calleerlandsson" "pick" +releases :: Name Owner -> Name Repo -> IO (Either Error (Vector Release)) +releases = releases' Nothing + +-- | All releases for the given repo with authentication. +-- +-- > releases' (Just (User (user, password))) "calleerlandsson" "pick" +releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) +releases' auth user repo = + executeRequestMaybe auth $ releasesR user repo FetchAll + +-- | List releases for a repository. +-- See +releasesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Release) +releasesR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "releases"] [] + +-- | Query a single release. +-- +-- > release "calleerlandsson" "pick" +release :: Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) +release = release' Nothing + +-- | Query a single release with authentication. +-- +-- > release' (Just (User (user, password))) "calleerlandsson" "pick" +release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) +release' auth user repo reqReleaseId = + executeRequestMaybe auth $ releaseR user repo reqReleaseId + +-- | Get a single release. +-- See +releaseR :: Name Owner -> Name Repo -> Id Release -> Request k Release +releaseR user repo reqReleaseId = + query ["repos", toPathPart user, toPathPart repo, "releases", toPathPart reqReleaseId ] [] + +-- | Query latest release. +-- +-- > latestRelease "calleerlandsson" "pick" +latestRelease :: Name Owner -> Name Repo -> IO (Either Error Release) +latestRelease = latestRelease' Nothing + +-- | Query latest release with authentication. +-- +-- > latestRelease' (Just (User (user, password))) "calleerlandsson" "pick" +latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) +latestRelease' auth user repo = + executeRequestMaybe auth $ latestReleaseR user repo + +-- | Get the latest release. +-- See +latestReleaseR :: Name Owner -> Name Repo -> Request k Release +latestReleaseR user repo = + query ["repos", toPathPart user, toPathPart repo, "releases", "latest" ] [] + +-- | Query release by tag name. +-- +-- > releaseByTagName "calleerlandsson" "pick" +releaseByTagName :: Name Owner -> Name Repo -> Text -> IO (Either Error Release) +releaseByTagName = releaseByTagName' Nothing + +-- | Query release by tag name with authentication. +-- +-- > releaseByTagName' (Just (User (user, password))) "calleerlandsson" "pick" +releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) +releaseByTagName' auth user repo reqTagName = + executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName + +-- | Get a release by tag name +-- See +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 +-} From 0c3be03a612e6941a745a367256cf476e428edcc Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Fri, 14 Jul 2017 19:39:46 +1000 Subject: [PATCH 055/309] Add function forkExistingRepoR Closes: https://github.com/phadej/github/issues/280 --- src/GitHub/Endpoints/Repos.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index b16ae23a..7eddfb2e 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -42,6 +42,7 @@ module GitHub.Endpoints.Repos ( createRepoR, createOrganizationRepo', createOrganizationRepoR, + forkExistingRepoR, -- ** Edit editRepo, @@ -172,6 +173,13 @@ createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) +-- | Fork an existing repository. +-- See +-- TODO: The third paramater (an optional Organisation) is not used yet. +forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'RW Repo +forkExistingRepoR owner repo _morg = + command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty + -- | Create a new repository for an organization. -- -- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} From c4f867ebe2e600176fc3170021e419340ee2cfc6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 24 Jul 2017 18:00:24 +0300 Subject: [PATCH 056/309] Update changelog --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7acdf273..42c63088 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ Changes for 0.16.0 - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies +- user events +- release endpoints +- forkExistingRepo Changes for 0.15.0 From be96fe66a4cfcc3f3318280ae169a86bd1d48da1 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 10 Jul 2017 17:15:37 -0700 Subject: [PATCH 057/309] Move current repos/contents API endpoints to GitHub.Endpoints.Repos.Contents. --- github.cabal | 1 + src/GitHub/Endpoints/Repos.hs | 49 --------------------- src/GitHub/Endpoints/Repos/Contents.hs | 59 ++++++++++++++++++++++++++ 3 files changed, 60 insertions(+), 49 deletions(-) create mode 100644 src/GitHub/Endpoints/Repos/Contents.hs diff --git a/github.cabal b/github.cabal index e67d0ab6..304cf918 100644 --- a/github.cabal +++ b/github.cabal @@ -112,6 +112,7 @@ Library GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits + GitHub.Endpoints.Repos.Contents GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 7eddfb2e..e9261db3 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -32,10 +32,6 @@ module GitHub.Endpoints.Repos ( branchesFor, branchesFor', branchesForR, - contentsFor, - contentsFor', - readmeFor, - readmeFor', -- ** Create createRepo', @@ -61,8 +57,6 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () -import qualified Data.Text.Encoding as TE - repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] @@ -323,49 +317,6 @@ branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branc 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 -> Text -> Maybe Text -> IO (Either Error Content) -contentsFor = contentsFor' Nothing - --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- With Authentication --- --- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing -contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) -contentsFor' auth user repo path ref = - executeRequestMaybe auth $ contentsForR user repo path ref - -contentsForR - :: Name Owner - -> Name Repo - -> Text -- ^ file or directory - -> Maybe Text -- ^ Git commit - -> Request k Content -contentsForR user repo path ref = - query ["repos", toPathPart user, toPathPart repo, "contents", path] qs - where - qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref - --- | The contents of a README file in a repo, given the repo owner and name --- --- > readmeFor "thoughtbot" "paperclip" -readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor = readmeFor' Nothing - --- | The contents of a README file in a repo, given the repo owner and name --- With Authentication --- --- > readmeFor' (Just (BasicAuth (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" diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs new file mode 100644 index 00000000..20ccf8c9 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -0,0 +1,59 @@ +module GitHub.Endpoints.Repos.Contents ( + -- * Querying repositories + contentsFor, + contentsFor', + contentsForR, + readmeFor, + readmeFor', + readmeForR + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +import qualified Data.Text.Encoding as TE + +-- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file +-- +-- > contentsFor "thoughtbot" "paperclip" "README.md" +contentsFor :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) +contentsFor = contentsFor' Nothing + +-- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file +-- With Authentication +-- +-- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing +contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) +contentsFor' auth user repo path ref = + executeRequestMaybe auth $ contentsForR user repo path ref + +contentsForR + :: Name Owner + -> Name Repo + -> Text -- ^ file or directory + -> Maybe Text -- ^ Git commit + -> Request k Content +contentsForR user repo path ref = + query ["repos", toPathPart user, toPathPart repo, "contents", path] qs + where + qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref + +-- | The contents of a README file in a repo, given the repo owner and name +-- +-- > readmeFor "thoughtbot" "paperclip" +readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) +readmeFor = readmeFor' Nothing + +-- | The contents of a README file in a repo, given the repo owner and name +-- With Authentication +-- +-- > readmeFor' (Just (BasicAuth (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"] [] From fab9d74360f8d73ffc96c78b063d2748d61bd10b Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 10 Jul 2017 18:10:19 -0700 Subject: [PATCH 058/309] Add create/update/delete file endpoints. --- src/GitHub/Data/Content.hs | 107 +++++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Contents.hs | 83 ++++++++++++++++++- 2 files changed, 188 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 9c17b81e..819c572b 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -55,6 +55,55 @@ data ContentInfo = ContentInfo { instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo +data Author = Author + { authorName :: !Text + , authorEmail :: !Text + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData Author where rnf = genericRnf +instance Binary Author + +data CreateFile = CreateFile + { createFilePath :: !Text + , createFileMessage :: !Text + , createFileContent :: !Text + , createFileBranch :: !(Maybe Text) + , createFileAuthor :: !(Maybe Author) + , createFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData CreateFile where rnf = genericRnf +instance Binary CreateFile + +data UpdateFile = UpdateFile + { updateFilePath :: !Text + , updateFileMessage :: !Text + , updateFileContent :: !Text + , updateFileSHA :: !Text + , updateFileBranch :: !(Maybe Text) + , updateFileAuthor :: !(Maybe Author) + , updateFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData UpdateFile where rnf = genericRnf +instance Binary UpdateFile + +data DeleteFile = DeleteFile + { deleteFilePath :: !Text + , deleteFileMessage :: !Text + , deleteFileSHA :: !Text + , deleteFileBranch :: !(Maybe Text) + , deleteFileAuthor :: !(Maybe Author) + , deleteFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData DeleteFile where rnf = genericRnf +instance Binary DeleteFile + instance FromJSON Content where parseJSON o@(Object _) = ContentFile <$> parseJSON o parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os @@ -87,3 +136,61 @@ instance FromJSON ContentInfo where <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" + +instance ToJSON Author where + toJSON (Author { authorName = name + , authorEmail = email + }) = object + [ "name" .= name + , "email" .= email + ] + +instance ToJSON CreateFile where + toJSON (CreateFile { createFilePath = path + , createFileMessage = message + , createFileContent = content + , createFileBranch = branch + , createFileAuthor = author + , createFileCommitter = committer + }) = object + [ "path" .= path + , "message" .= message + , "content" .= content + , "branch" .= branch + , "author" .= author + , "committer" .= committer + ] + +instance ToJSON UpdateFile where + toJSON (UpdateFile { updateFilePath = path + , updateFileMessage = message + , updateFileContent = content + , updateFileSHA = sha + , updateFileBranch = branch + , updateFileAuthor = author + , updateFileCommitter = committer + }) = object + [ "path" .= path + , "message" .= message + , "content" .= content + , "sha" .= sha + , "branch" .= branch + , "author" .= author + , "committer" .= committer + ] + +instance ToJSON DeleteFile where + toJSON (DeleteFile { deleteFilePath = path + , deleteFileMessage = message + , deleteFileSHA = sha + , deleteFileBranch = branch + , deleteFileAuthor = author + , deleteFileCommitter = committer + }) = object + [ "path" .= path + , "message" .= message + , "sha" .= sha + , "branch" .= branch + , "author" .= author + , "committer" .= committer + ] diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 20ccf8c9..bb54d8f9 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -1,11 +1,30 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github Repo Contents API, as documented at +-- module GitHub.Endpoints.Repos.Contents ( - -- * Querying repositories + -- * Querying contents contentsFor, contentsFor', contentsForR, readmeFor, readmeFor', - readmeForR + readmeForR, + + -- ** Create + createFile, + createFileR, + + -- ** Update + updateFile, + updateFileR, + + -- ** Delete + deleteFile, + deleteFileR ) where import GitHub.Data @@ -57,3 +76,63 @@ readmeFor' auth user repo = readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = query ["repos", toPathPart user, toPathPart repo, "readme"] [] + +-- | Create a file. +createFile + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> CreateFile + -> IO (Either Error Content) +createFile auth user repo body = + executeRequest auth $ createFileR user repo body + +-- | Create a file. +-- See +createFileR + :: Name Owner + -> Name Repo + -> CreateFile + -> Request 'RW Content +createFileR user repo body = + command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) + +-- | Update a file. +updateFile + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> UpdateFile + -> IO (Either Error Content) +updateFile auth user repo body = + executeRequest auth $ updateFileR user repo body + +-- | Update a file. +-- See +updateFileR + :: Name Owner + -> Name Repo + -> UpdateFile + -> Request 'RW Content +updateFileR user repo body = + command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) + +-- | Delete a file. +deleteFile + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> DeleteFile + -> IO (Either Error ()) +deleteFile auth user repo body = + executeRequest auth $ deleteFileR user repo body + +-- | Delete a file. +-- See +deleteFileR + :: Name Owner + -> Name Repo + -> DeleteFile + -> Request 'RW () +deleteFileR user repo body = + command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) From 00c5f30c56fd382460e9e77c49823e5768f016a7 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 07:54:56 -0700 Subject: [PATCH 059/309] Export module GitHub.Data from GitHub.Endpoints.Repos.Contents. --- src/GitHub/Endpoints/Repos/Contents.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index bb54d8f9..c5697cb8 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -24,7 +24,9 @@ module GitHub.Endpoints.Repos.Contents ( -- ** Delete deleteFile, - deleteFileR + deleteFileR, + + module GitHub.Data ) where import GitHub.Data From 1cae1e2ac6e63c0eec3e5df53432c650a9e12c9f Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 08:10:40 -0700 Subject: [PATCH 060/309] Fix result type for content file endpoints. --- src/GitHub/Data/Content.hs | 16 ++++++++++++++++ src/GitHub/Endpoints/Repos/Contents.hs | 8 ++++---- 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 819c572b..62a68727 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -5,6 +5,7 @@ -- module GitHub.Data.Content where +import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude import Prelude () @@ -55,6 +56,15 @@ data ContentInfo = ContentInfo { instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo +data ContentResult = ContentResult + { contentResultInfo :: !ContentInfo + , contentResultSize :: !Int + , contentResultCommit :: !Commit + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentResult where rnf = genericRnf +instance Binary ContentResult + data Author = Author { authorName :: !Text , authorEmail :: !Text @@ -137,6 +147,12 @@ instance FromJSON ContentInfo where <*> o .: "git_url" <*> o .: "html_url" +instance FromJSON ContentResult where + parseJSON = withObject "ContentResult" $ \o -> + ContentResult <$> parseJSON (Object o) + <*> o .: "size" + <*> o .: "commit" + instance ToJSON Author where toJSON (Author { authorName = name , authorEmail = email diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index c5697cb8..98c292a9 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -85,7 +85,7 @@ createFile -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> CreateFile - -> IO (Either Error Content) + -> IO (Either Error ContentResult) createFile auth user repo body = executeRequest auth $ createFileR user repo body @@ -95,7 +95,7 @@ createFileR :: Name Owner -> Name Repo -> CreateFile - -> Request 'RW Content + -> Request 'RW ContentResult createFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) @@ -105,7 +105,7 @@ updateFile -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> UpdateFile - -> IO (Either Error Content) + -> IO (Either Error ContentResult) updateFile auth user repo body = executeRequest auth $ updateFileR user repo body @@ -115,7 +115,7 @@ updateFileR :: Name Owner -> Name Repo -> UpdateFile - -> Request 'RW Content + -> Request 'RW ContentResult updateFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) From bf73c80cccfd220f6888b201b4a290a7a02e2d54 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 10:40:30 -0700 Subject: [PATCH 061/309] Fix repo content endpoint result types. --- src/GitHub/Data/Content.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 62a68727..89a8c1ba 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -56,10 +56,17 @@ data ContentInfo = ContentInfo { instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo +data ContentResultInfo = ContentResultInfo + { contentResultInfo :: !ContentInfo + , contentResultSize :: !Int + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentResultInfo where rnf = genericRnf +instance Binary ContentResultInfo + data ContentResult = ContentResult - { contentResultInfo :: !ContentInfo - , contentResultSize :: !Int - , contentResultCommit :: !Commit + { contentResultContent :: !ContentResultInfo + , contentResultCommit :: !GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentResult where rnf = genericRnf @@ -147,10 +154,14 @@ instance FromJSON ContentInfo where <*> 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 <$> parseJSON (Object o) - <*> o .: "size" + ContentResult <$> o .: "content" <*> o .: "commit" instance ToJSON Author where From 330739da9d2b6eef7eb671272a146090afeeb91a Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 11:13:33 -0700 Subject: [PATCH 062/309] Omit Nothing values from resulting JSON. --- src/GitHub/Data/Content.hs | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 89a8c1ba..f4d6a7e5 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -5,6 +5,8 @@ -- module GitHub.Data.Content where +import Data.Aeson.Types (KeyValue) +import Data.Maybe (maybe) import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude @@ -179,14 +181,14 @@ instance ToJSON CreateFile where , createFileBranch = branch , createFileAuthor = author , createFileCommitter = committer - }) = object + }) = object $ [ "path" .= path , "message" .= message , "content" .= content - , "branch" .= branch - , "author" .= author - , "committer" .= committer ] + ++ "branch" .=? branch + ++ "author" .=? author + ++ "committer" .=? committer instance ToJSON UpdateFile where toJSON (UpdateFile { updateFilePath = path @@ -196,15 +198,15 @@ instance ToJSON UpdateFile where , updateFileBranch = branch , updateFileAuthor = author , updateFileCommitter = committer - }) = object + }) = object $ [ "path" .= path , "message" .= message , "content" .= content , "sha" .= sha - , "branch" .= branch - , "author" .= author - , "committer" .= committer ] + ++ "branch" .=? branch + ++ "author" .=? author + ++ "committer" .=? committer instance ToJSON DeleteFile where toJSON (DeleteFile { deleteFilePath = path @@ -213,11 +215,14 @@ instance ToJSON DeleteFile where , deleteFileBranch = branch , deleteFileAuthor = author , deleteFileCommitter = committer - }) = object + }) = object $ [ "path" .= path , "message" .= message , "sha" .= sha - , "branch" .= branch - , "author" .= author - , "committer" .= committer ] + ++ "branch" .=? branch + ++ "author" .=? author + ++ "committer" .=? committer + +(.=?) :: ToJSON v => KeyValue t => Text -> Maybe v -> [t] +name .=? value = maybe [] (pure . (name .=)) value From 779315b3d24968be9c766768523729f45da4cdda Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 24 Jul 2017 09:34:43 -0700 Subject: [PATCH 063/309] Use RecordWildCards and Aeson.Pair. --- src/GitHub/Data/Content.hs | 86 +++++++++++++++----------------------- 1 file changed, 33 insertions(+), 53 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index f4d6a7e5..81b44177 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -5,7 +6,7 @@ -- module GitHub.Data.Content where -import Data.Aeson.Types (KeyValue) +import Data.Aeson.Types (Pair) import Data.Maybe (maybe) import GitHub.Data.GitData import GitHub.Data.URL @@ -167,62 +168,41 @@ instance FromJSON ContentResult where <*> o .: "commit" instance ToJSON Author where - toJSON (Author { authorName = name - , authorEmail = email - }) = object - [ "name" .= name - , "email" .= email - ] + toJSON Author {..} = object + [ "name" .= authorName + , "email" .= authorEmail + ] instance ToJSON CreateFile where - toJSON (CreateFile { createFilePath = path - , createFileMessage = message - , createFileContent = content - , createFileBranch = branch - , createFileAuthor = author - , createFileCommitter = committer - }) = object $ - [ "path" .= path - , "message" .= message - , "content" .= content - ] - ++ "branch" .=? branch - ++ "author" .=? author - ++ "committer" .=? committer + toJSON CreateFile {..} = object $ + [ "path" .= createFilePath + , "message" .= createFileMessage + , "content" .= createFileContent + ] + ++ "branch" .=? createFileBranch + ++ "author" .=? createFileAuthor + ++ "committer" .=? createFileCommitter instance ToJSON UpdateFile where - toJSON (UpdateFile { updateFilePath = path - , updateFileMessage = message - , updateFileContent = content - , updateFileSHA = sha - , updateFileBranch = branch - , updateFileAuthor = author - , updateFileCommitter = committer - }) = object $ - [ "path" .= path - , "message" .= message - , "content" .= content - , "sha" .= sha - ] - ++ "branch" .=? branch - ++ "author" .=? author - ++ "committer" .=? committer + toJSON UpdateFile {..} = object $ + [ "path" .= updateFilePath + , "message" .= updateFileMessage + , "content" .= updateFileContent + , "sha" .= updateFileSHA + ] + ++ "branch" .=? updateFileBranch + ++ "author" .=? updateFileAuthor + ++ "committer" .=? updateFileCommitter instance ToJSON DeleteFile where - toJSON (DeleteFile { deleteFilePath = path - , deleteFileMessage = message - , deleteFileSHA = sha - , deleteFileBranch = branch - , deleteFileAuthor = author - , deleteFileCommitter = committer - }) = object $ - [ "path" .= path - , "message" .= message - , "sha" .= sha - ] - ++ "branch" .=? branch - ++ "author" .=? author - ++ "committer" .=? committer - -(.=?) :: ToJSON v => KeyValue t => Text -> Maybe v -> [t] + toJSON DeleteFile {..} = object $ + [ "path" .= deleteFilePath + , "message" .= deleteFileMessage + , "sha" .= deleteFileSHA + ] + ++ "branch" .=? deleteFileBranch + ++ "author" .=? deleteFileAuthor + ++ "committer" .=? deleteFileCommitter + +(.=?) :: ToJSON v => Text -> Maybe v -> [Pair] name .=? value = maybe [] (pure . (name .=)) value From 8a851fe960eea3304c6ea042ccf3005cba47a2e4 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 24 Jul 2017 10:31:16 -0700 Subject: [PATCH 064/309] Add Contents example to cabal file and update code. --- samples/Repos/Contents.hs | 56 ++++++++++++++++++++++-------------- samples/github-samples.cabal | 14 +++++++++ 2 files changed, 48 insertions(+), 22 deletions(-) diff --git a/samples/Repos/Contents.hs b/samples/Repos/Contents.hs index 2b3c1cb6..87b61f5a 100644 --- a/samples/Repos/Contents.hs +++ b/samples/Repos/Contents.hs @@ -1,9 +1,18 @@ -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 Data.Text + (Text, intercalate, pack, take, unlines) +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 +22,37 @@ main = do putStrLn "=======" getContents "LICENSE" +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 item = - "type: " ++ show (Github.contentItemType item) ++ "\n" ++ - formatContentInfo (Github.contentItemInfo item) + "type: " <> tshow (GitHub.contentItemType item) <> "\n" <> + formatContentInfo (GitHub.contentItemInfo item) -truncate str = take 40 str ++ "... (truncated)" +truncate str = take 40 str <> "... (truncated)" diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 826c3e1e..95d3e073 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -190,6 +190,20 @@ executable github-operational , transformers-compat default-language: Haskell2010 +executable github-repos-contents-example + main-is: Contents.hs + hs-source-dirs: + Repos + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , github-samples + , text + , vector + default-language: Haskell2010 + executable github-show-deploy-key main-is: ShowDeployKey.hs hs-source-dirs: From 80b8e69702dcd0c8f60b1f771ba1b86dbd1f8193 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 24 Jul 2017 11:29:22 -0700 Subject: [PATCH 065/309] Add create/update/delete example. --- samples/Repos/Contents.hs | 62 ++++++++++++++++++++++++++++++++++-- samples/github-samples.cabal | 1 + 2 files changed, 61 insertions(+), 2 deletions(-) diff --git a/samples/Repos/Contents.hs b/samples/Repos/Contents.hs index 87b61f5a..3132c6f5 100644 --- a/samples/Repos/Contents.hs +++ b/samples/Repos/Contents.hs @@ -5,8 +5,10 @@ module Main where import Common hiding (getContents, intercalate, take, truncate, unlines) +import qualified Data.ByteString.Base64 as Base64 import Data.Text - (Text, intercalate, pack, take, unlines) + (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 @@ -22,6 +24,8 @@ main = do putStrLn "=======" getContents "LICENSE" + createUpdateDeleteSampleFile + getContents :: Text -> IO () getContents path = do contents <- GitHub.contentsFor "mike-burns" "ohlaunch" path Nothing @@ -50,9 +54,63 @@ formatContentInfo contentInfo = , "html url: " <> (GitHub.getUrl . GitHub.contentHtmlUrl) contentInfo ] +formatItem :: GitHub.ContentItem -> Text formatItem item = "type: " <> tshow (GitHub.contentItemType item) <> "\n" <> formatContentInfo (GitHub.contentItemInfo item) - +truncate :: Text -> Text truncate str = take 40 str <> "... (truncated)" + +createUpdateDeleteSampleFile :: IO () +createUpdateDeleteSampleFile = do + let + auth = GitHub.OAuth "oauthtoken" + owner = "repoOwner" + repo = "repoName" + author = GitHub.Author + { GitHub.authorName = "John Doe" + , GitHub.authorEmail = "johndoe@example.com" + } + defaultBranch = Nothing + base64Encode = decodeUtf8 . Base64.encode . encodeUtf8 + createResult <- failOnError $ GitHub.createFile auth owner repo + GitHub.CreateFile + { GitHub.createFilePath = "sample.txt" + , GitHub.createFileMessage = "Add sample.txt" + , GitHub.createFileContent = base64Encode "Hello" + , GitHub.createFileBranch = defaultBranch + , GitHub.createFileAuthor = Just author + , GitHub.createFileCommitter = Just author + } + + let getResultSHA = GitHub.contentSha . GitHub.contentResultInfo . GitHub.contentResultContent + let createFileSHA = getResultSHA createResult + updateResult <- failOnError $ GitHub.updateFile auth owner repo + GitHub.UpdateFile + { GitHub.updateFilePath = "sample.txt" + , GitHub.updateFileMessage = "Update sample.txt" + , GitHub.updateFileContent = base64Encode "Hello world!" + , GitHub.updateFileSHA = createFileSHA + , GitHub.updateFileBranch = defaultBranch + , GitHub.updateFileAuthor = Just author + , GitHub.updateFileCommitter = Just author + } + + let updateFileSHA = getResultSHA updateResult + failOnError $ GitHub.deleteFile auth owner repo + GitHub.DeleteFile + { GitHub.deleteFilePath = "sample.txt" + , GitHub.deleteFileMessage = "Delete sample.txt" + , GitHub.deleteFileSHA = updateFileSHA + , GitHub.deleteFileBranch = defaultBranch + , GitHub.deleteFileAuthor = Just author + , GitHub.deleteFileCommitter = Just author + } + +failOnError :: IO (Either GitHub.Error a) -> IO a +failOnError c = c >>= go + where + go r = case r of + Left err -> fail . show $ err + Right x -> return x diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 95d3e073..830c1e37 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -198,6 +198,7 @@ executable github-repos-contents-example build-depends: base , base-compat + , base64-bytestring , github , github-samples , text From cd064096ad4c99b5766ff5c6d6912833974f0350 Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Sat, 8 Jul 2017 23:23:29 +0100 Subject: [PATCH 066/309] Add support for pull request reviews https://developer.github.com/v3/pulls/reviews/ --- github.cabal | 3 + spec/GitHub/PullRequestReviewsSpec.hs | 32 ++++ src/GitHub.hs | 20 +++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Reviews.hs | 100 +++++++++++ src/GitHub/Endpoints/PullRequests/Reviews.hs | 172 +++++++++++++++++++ 6 files changed, 329 insertions(+) create mode 100644 spec/GitHub/PullRequestReviewsSpec.hs create mode 100644 src/GitHub/Data/Reviews.hs create mode 100644 src/GitHub/Endpoints/PullRequests/Reviews.hs diff --git a/github.cabal b/github.cabal index 304cf918..574a38ca 100644 --- a/github.cabal +++ b/github.cabal @@ -84,6 +84,7 @@ Library GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request + GitHub.Data.Reviews GitHub.Data.Search GitHub.Data.Teams GitHub.Data.URL @@ -107,6 +108,7 @@ Library GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests + GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.ReviewComments GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators @@ -172,6 +174,7 @@ test-suite github-test GitHub.OrganizationsSpec GitHub.IssuesSpec GitHub.PullRequestsSpec + GitHub.PullRequestReviewsSpec GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs new file mode 100644 index 00000000..b602af7e --- /dev/null +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.PullRequestReviewsSpec where + +import qualified GitHub +import GitHub.Data.Id (Id(Id)) + +import Prelude () +import Prelude.Compat + +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) + +withAuth :: (GitHub.Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GitHub.OAuth $ fromString token) + +spec :: Spec +spec = do + describe "reviewsForR" $ do + it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do + cs <- GitHub.executeRequest auth $ + GitHub.reviewsForR owner repo prid GitHub.FetchAll + cs `shouldSatisfy` isRight + where + prs = + [("phadej", "github", Id 268)] diff --git a/src/GitHub.hs b/src/GitHub.hs index e45282e6..28588cf2 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -210,6 +210,25 @@ module GitHub ( pullRequestReviewCommentsR, pullRequestReviewCommentR, + -- ** 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 + reviewsForR, + reviewsFor, + reviewsFor', + reviewForR, + reviewFor, + reviewFor', + reviewCommentsForR, + reviewCommentsFor, + reviewCommentsFor', + -- * Repositories -- | See -- @@ -334,6 +353,7 @@ import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests +import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.ReviewComments import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index e318313f..38d4efab 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -46,6 +46,7 @@ module GitHub.Data ( module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, + module GitHub.Data.Reviews, module GitHub.Data.Search, module GitHub.Data.Teams, module GitHub.Data.URL, @@ -73,6 +74,7 @@ import GitHub.Data.PullRequests import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request +import GitHub.Data.Reviews import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.URL diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs new file mode 100644 index 00000000..db3ceba6 --- /dev/null +++ b/src/GitHub/Data/Reviews.hs @@ -0,0 +1,100 @@ +module GitHub.Data.Reviews where + +import Data.Text (Text) +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Data.Id (Id(Id)) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + + +data ReviewState + = ReviewStatePending + | ReviewStateApproved + | ReviewStateDismissed + | ReviewStateCommented + | ReviewStateChangesRequested + deriving (Show, Enum, Bounded, Eq, Ord, Generic) + + +instance NFData ReviewState where rnf = genericRnf +instance Binary ReviewState + + +instance FromJSON ReviewState where + parseJSON (String "APPROVED") = pure ReviewStateApproved + parseJSON (String "PENDING") = pure ReviewStatePending + parseJSON (String "DISMISSED") = pure ReviewStateDismissed + parseJSON (String "COMMENTED") = pure ReviewStateCommented + parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested + parseJSON _ = fail "Unexpected ReviewState" + + +data Review = Review + { reviewBody :: !Text + , reviewCommitId :: !Text + , reviewState :: ReviewState + , reviewSubmittedAt :: !UTCTime + , reviewPullRequestUrl :: !URL + , reviewHtmlUrl :: !Text + , reviewUser :: !SimpleUser + , reviewId :: !(Id Review) + } deriving (Show, Generic) + + +instance NFData Review where rnf = genericRnf +instance Binary Review + + +instance FromJSON Review where + parseJSON = withObject "Review" $ \o -> Review + <$> o .: "body" + <*> o .: "commit_id" + <*> o .: "state" + <*> o .: "submitted_at" + <*> o .: "pull_request_url" + <*> o .: "html_url" + <*> o .: "user" + <*> o .: "id" + + +data ReviewComment = ReviewComment + { 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 + , reviewCommentUser :: !SimpleUser + , reviewCommentId :: !(Id ReviewComment) + } deriving (Show, Generic) + + +instance NFData ReviewComment where rnf = genericRnf +instance Binary ReviewComment + + +instance FromJSON ReviewComment where + parseJSON = withObject "ReviewComment" $ \o -> ReviewComment + <$> 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" + <*> o .: "user" + <*> o .: "id" diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs new file mode 100644 index 00000000..984a53c9 --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -0,0 +1,172 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The reviews API as described on . +module GitHub.Endpoints.PullRequests.Reviews + ( reviewsForR + , reviewsFor + , reviewsFor' + , reviewForR + , reviewFor + , reviewFor' + , reviewCommentsForR + , reviewCommentsFor + , reviewCommentsFor' + , module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude +import GitHub.Request + (Request, executeRequest', executeRequestMaybe) +import Prelude () + + +-- | List reviews for a pull request. +-- See +reviewsForR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> FetchCount + -> Request k (Vector Review) +reviewsForR owner repo prid = + pagedQuery + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + ] + [] + + +-- | All reviews for a pull request given the repo owner, repo name and the pull +-- request id. +-- +-- > reviewsFor "thoughtbot" "paperclip" (Id 101) +reviewsFor :: Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +reviewsFor owner repo prid = + executeRequest' $ reviewsForR owner repo prid FetchAll + + +-- | All reviews for a pull request given the repo owner, repo name and the pull +-- request id. With authentication. +-- +-- > reviewsFor' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) +reviewsFor' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +reviewsFor' auth owner repo pr = + executeRequestMaybe auth $ reviewsForR owner repo pr FetchAll + + +-- | Query a single pull request review. +-- see +reviewForR :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k Review +reviewForR owner repo prid rid = + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + ] + [] + + +-- | A detailed review on a pull request given the repo owner, repo name, pull +-- request id and review id. +-- +-- > reviewFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewFor + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) +reviewFor owner repo prid rid = + executeRequest' $ reviewForR owner repo prid rid + + +-- | A detailed review on a pull request given the repo owner, repo name, pull +-- request id and review id. With authentication. +-- +-- > reviewFor' (Just ("github-username", "github-password")) +-- "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewFor' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) +reviewFor' auth owner repo prid rid = + executeRequestMaybe auth $ reviewForR owner repo prid rid + + +-- | Query the comments for a single pull request review. +-- see +reviewCommentsForR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k [ReviewComment] +reviewCommentsForR owner repo prid rid = + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + , "comments" + ] + [] + + +-- | All comments for a review on a pull request given the repo owner, repo +-- name, pull request id and review id. +-- +-- > reviewCommentsFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewCommentsFor + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) +reviewCommentsFor owner repo prid rid = + executeRequest' $ reviewCommentsForR owner repo prid rid + + +-- | All comments for a review on a pull request given the repo owner, repo +-- name, pull request id and review id. With authentication. +-- +-- > reviewCommentsFor' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewCommentsFor' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) +reviewCommentsFor' auth owner repo prid rid = + executeRequestMaybe auth $ reviewCommentsForR owner repo prid rid From ded3b6a270ce6cab54eac4e546a35369e825d8aa Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Thu, 13 Jul 2017 20:40:56 +0100 Subject: [PATCH 067/309] Rename pull request review functions Rename pullRequestReviewComment to pullRequestComment Rename reviewsFor to pullRequestReviewComment --- samples/Pulls/ReviewComments/ListComments.hs | 2 +- samples/Pulls/ReviewComments/ShowComment.hs | 2 +- spec/GitHub/PullRequestReviewsSpec.hs | 4 +- src/GitHub.hs | 22 ++--- .../Endpoints/PullRequests/ReviewComments.hs | 32 +++---- src/GitHub/Endpoints/PullRequests/Reviews.hs | 92 +++++++++---------- 6 files changed, 77 insertions(+), 77 deletions(-) diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs index f41234f2..d16eb34a 100644 --- a/samples/Pulls/ReviewComments/ListComments.hs +++ b/samples/Pulls/ReviewComments/ListComments.hs @@ -4,7 +4,7 @@ import qualified Github.PullRequests.ReviewComments as Github import Data.List main = do - possiblePullRequestComments <- Github.pullRequestReviewComments "thoughtbot" "factory_girl" 256 + possiblePullRequestComments <- Github.pullRequestComments "thoughtbot" "factory_girl" 256 case possiblePullRequestComments of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/ReviewComments/ShowComment.hs index 254fa703..95eb48e7 100644 --- a/samples/Pulls/ReviewComments/ShowComment.hs +++ b/samples/Pulls/ReviewComments/ShowComment.hs @@ -4,7 +4,7 @@ import qualified Github.PullRequests.ReviewComments as Github import Data.List main = do - possiblePullRequestComment <- Github.pullRequestReviewComment "thoughtbot" "factory_girl" 301819 + possiblePullRequestComment <- Github.pullRequestComment "thoughtbot" "factory_girl" 301819 case possiblePullRequestComment of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right comment) -> putStrLn $ formatComment comment diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index b602af7e..c04b134b 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -22,10 +22,10 @@ withAuth action = do spec :: Spec spec = do - describe "reviewsForR" $ do + describe "pullRequestReviewsR" $ do it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do cs <- GitHub.executeRequest auth $ - GitHub.reviewsForR owner repo prid GitHub.FetchAll + GitHub.pullRequestReviewsR owner repo prid GitHub.FetchAll cs `shouldSatisfy` isRight where prs = diff --git a/src/GitHub.hs b/src/GitHub.hs index 28588cf2..2aadfdb4 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -207,8 +207,8 @@ module GitHub ( -- * Create a comment -- * Edit a comment -- * Delete a comment - pullRequestReviewCommentsR, - pullRequestReviewCommentR, + pullRequestCommentsR, + pullRequestCommentR, -- ** Pull request reviews -- | See @@ -219,15 +219,15 @@ module GitHub ( -- * Create a pull request review -- * Submit a pull request review -- * Dismiss a pull request review - reviewsForR, - reviewsFor, - reviewsFor', - reviewForR, - reviewFor, - reviewFor', - reviewCommentsForR, - reviewCommentsFor, - reviewCommentsFor', + pullRequestReviewsR, + pullRequestReviews, + pullRequestReviews', + pullRequestReviewR, + pullRequestReview, + pullRequestReview', + pullRequestReviewCommentsR, + pullRequestReviewCommentsIO, + pullRequestReviewCommentsIO', -- * Repositories -- | See diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index eee75046..32b84318 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -6,10 +6,10 @@ -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.ReviewComments ( - pullRequestReviewCommentsIO, - pullRequestReviewCommentsR, - pullRequestReviewComment, - pullRequestReviewCommentR, + pullRequestCommentsIO, + pullRequestCommentsR, + pullRequestComment, + pullRequestCommentR, module GitHub.Data, ) where @@ -20,26 +20,26 @@ import Prelude () -- | 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 FetchAll +-- > pullRequestComments "thoughtbot" "factory_girl" (Id 256) +pullRequestCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) +pullRequestCommentsIO user repo prid = + executeRequest' $ pullRequestCommentsR user repo prid FetchAll -- | List comments on a pull request. -- See -pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) -pullRequestReviewCommentsR user repo prid = +pullRequestCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) +pullRequestCommentsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- --- > 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 +-- > pullRequestComment "thoughtbot" "factory_girl" (Id 301819) +pullRequestComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) +pullRequestComment user repo cid = + executeRequest' $ pullRequestCommentR user repo cid -- | Query a single comment. -- See -pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment -pullRequestReviewCommentR user repo cid = +pullRequestCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment +pullRequestCommentR 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 index 984a53c9..9f5d8e66 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -5,15 +5,15 @@ -- -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews - ( reviewsForR - , reviewsFor - , reviewsFor' - , reviewForR - , reviewFor - , reviewFor' - , reviewCommentsForR - , reviewCommentsFor - , reviewCommentsFor' + ( pullRequestReviewsR + , pullRequestReviews + , pullRequestReviews' + , pullRequestReviewR + , pullRequestReview + , pullRequestReview' + , pullRequestReviewCommentsR + , pullRequestReviewCommentsIO + , pullRequestReviewCommentsIO' , module GitHub.Data ) where @@ -27,13 +27,13 @@ import Prelude () -- | List reviews for a pull request. -- See -reviewsForR +pullRequestReviewsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Review) -reviewsForR owner repo prid = +pullRequestReviewsR owner repo prid = pagedQuery [ "repos" , toPathPart owner @@ -48,37 +48,37 @@ reviewsForR owner repo prid = -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. -- --- > reviewsFor "thoughtbot" "paperclip" (Id 101) -reviewsFor :: Name Owner - -> Name Repo - -> Id PullRequest - -> IO (Either Error (Vector Review)) -reviewsFor owner repo prid = - executeRequest' $ reviewsForR owner repo prid FetchAll +-- > pullRequestReviews "thoughtbot" "paperclip" (Id 101) +pullRequestReviews :: Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +pullRequestReviews owner repo prid = + executeRequest' $ pullRequestReviewsR owner repo prid FetchAll -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. With authentication. -- --- > reviewsFor' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) -reviewsFor' +-- > pullRequestReviews' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) +pullRequestReviews' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Review)) -reviewsFor' auth owner repo pr = - executeRequestMaybe auth $ reviewsForR owner repo pr FetchAll +pullRequestReviews' auth owner repo pr = + executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll -- | Query a single pull request review. -- see -reviewForR :: Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> Request k Review -reviewForR owner repo prid rid = +pullRequestReviewR :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k Review +pullRequestReviewR owner repo prid rid = query [ "repos" , toPathPart owner @@ -94,42 +94,42 @@ reviewForR owner repo prid rid = -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. -- --- > reviewFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewFor +-- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReview :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) -reviewFor owner repo prid rid = - executeRequest' $ reviewForR owner repo prid rid +pullRequestReview owner repo prid rid = + executeRequest' $ pullRequestReviewR owner repo prid rid -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. With authentication. -- --- > reviewFor' (Just ("github-username", "github-password")) +-- > pullRequestReview' (Just ("github-username", "github-password")) -- "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewFor' +pullRequestReview' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) -reviewFor' auth owner repo prid rid = - executeRequestMaybe auth $ reviewForR owner repo prid rid +pullRequestReview' auth owner repo prid rid = + executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid -- | Query the comments for a single pull request review. -- see -reviewCommentsForR +pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> Request k [ReviewComment] -reviewCommentsForR owner repo prid rid = +pullRequestReviewCommentsR owner repo prid rid = query [ "repos" , toPathPart owner @@ -146,27 +146,27 @@ reviewCommentsForR owner repo prid rid = -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. -- --- > reviewCommentsFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewCommentsFor +-- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) -reviewCommentsFor owner repo prid rid = - executeRequest' $ reviewCommentsForR owner repo prid rid +pullRequestReviewCommentsIO owner repo prid rid = + executeRequest' $ pullRequestReviewCommentsR owner repo prid rid -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. With authentication. -- --- > reviewCommentsFor' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewCommentsFor' +-- > pullRequestReviewComments' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) -reviewCommentsFor' auth owner repo prid rid = - executeRequestMaybe auth $ reviewCommentsForR owner repo prid rid +pullRequestReviewCommentsIO' auth owner repo prid rid = + executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid From 747eb42c220af37e0a7af99ba12a24504b41ed67 Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Thu, 13 Jul 2017 21:20:22 +0100 Subject: [PATCH 068/309] Indent with 4 spaces --- src/GitHub/Data/Reviews.hs | 142 +++++++------ src/GitHub/Endpoints/PullRequests/Reviews.hs | 197 +++++++++---------- 2 files changed, 164 insertions(+), 175 deletions(-) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index db3ceba6..174457c7 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -7,94 +7,90 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () - data ReviewState - = ReviewStatePending - | ReviewStateApproved - | ReviewStateDismissed - | ReviewStateCommented - | ReviewStateChangesRequested - deriving (Show, Enum, Bounded, Eq, Ord, Generic) + = ReviewStatePending + | ReviewStateApproved + | ReviewStateDismissed + | ReviewStateCommented + | ReviewStateChangesRequested + deriving (Show, Enum, Bounded, Eq, Ord, Generic) +instance NFData ReviewState where + rnf = genericRnf -instance NFData ReviewState where rnf = genericRnf instance Binary ReviewState - instance FromJSON ReviewState where - parseJSON (String "APPROVED") = pure ReviewStateApproved - parseJSON (String "PENDING") = pure ReviewStatePending - parseJSON (String "DISMISSED") = pure ReviewStateDismissed - parseJSON (String "COMMENTED") = pure ReviewStateCommented - parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested - parseJSON _ = fail "Unexpected ReviewState" - + parseJSON (String "APPROVED") = pure ReviewStateApproved + parseJSON (String "PENDING") = pure ReviewStatePending + parseJSON (String "DISMISSED") = pure ReviewStateDismissed + parseJSON (String "COMMENTED") = pure ReviewStateCommented + parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested + parseJSON _ = fail "Unexpected ReviewState" data Review = Review - { reviewBody :: !Text - , reviewCommitId :: !Text - , reviewState :: ReviewState - , reviewSubmittedAt :: !UTCTime - , reviewPullRequestUrl :: !URL - , reviewHtmlUrl :: !Text - , reviewUser :: !SimpleUser - , reviewId :: !(Id Review) - } deriving (Show, Generic) - + { reviewBody :: !Text + , reviewCommitId :: !Text + , reviewState :: ReviewState + , reviewSubmittedAt :: !UTCTime + , reviewPullRequestUrl :: !URL + , reviewHtmlUrl :: !Text + , reviewUser :: !SimpleUser + , reviewId :: !(Id Review) + } deriving (Show, Generic) + +instance NFData Review where + rnf = genericRnf -instance NFData Review where rnf = genericRnf instance Binary Review - instance FromJSON Review where - parseJSON = withObject "Review" $ \o -> Review - <$> o .: "body" - <*> o .: "commit_id" - <*> o .: "state" - <*> o .: "submitted_at" - <*> o .: "pull_request_url" - <*> o .: "html_url" - <*> o .: "user" - <*> o .: "id" - + 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 - { 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 - , reviewCommentUser :: !SimpleUser - , reviewCommentId :: !(Id ReviewComment) - } deriving (Show, Generic) + { 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 + , reviewCommentUser :: !SimpleUser + , reviewCommentId :: !(Id ReviewComment) + } deriving (Show, Generic) + +instance NFData ReviewComment where + rnf = genericRnf - -instance NFData ReviewComment where rnf = genericRnf instance Binary ReviewComment - instance FromJSON ReviewComment where - parseJSON = withObject "ReviewComment" $ \o -> ReviewComment - <$> 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" - <*> o .: "user" - <*> o .: "id" + parseJSON = + withObject "ReviewComment" $ \o -> + ReviewComment <$> 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" <*> + o .: "user" <*> + o .: "id" diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 9f5d8e66..50b433fd 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -5,17 +5,17 @@ -- -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews - ( pullRequestReviewsR - , pullRequestReviews - , pullRequestReviews' - , pullRequestReviewR - , pullRequestReview - , pullRequestReview' - , pullRequestReviewCommentsR - , pullRequestReviewCommentsIO - , pullRequestReviewCommentsIO' - , module GitHub.Data - ) where + ( pullRequestReviewsR + , pullRequestReviews + , pullRequestReviews' + , pullRequestReviewR + , pullRequestReview + , pullRequestReview' + , pullRequestReviewCommentsR + , pullRequestReviewCommentsIO + , pullRequestReviewCommentsIO' + , module GitHub.Data + ) where import GitHub.Data import GitHub.Data.Id (Id) @@ -24,86 +24,82 @@ import GitHub.Request (Request, executeRequest', executeRequestMaybe) import Prelude () - -- | List reviews for a pull request. -- See pullRequestReviewsR - :: Name Owner - -> Name Repo - -> Id PullRequest - -> FetchCount - -> Request k (Vector Review) + :: Name Owner + -> Name Repo + -> Id PullRequest + -> FetchCount + -> Request k (Vector Review) pullRequestReviewsR owner repo prid = - pagedQuery - [ "repos" - , toPathPart owner - , toPathPart repo - , "pulls" - , toPathPart prid - , "reviews" - ] - [] - + pagedQuery + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + ] + [] -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. -- -- > pullRequestReviews "thoughtbot" "paperclip" (Id 101) -pullRequestReviews :: Name Owner - -> Name Repo - -> Id PullRequest - -> IO (Either Error (Vector Review)) +pullRequestReviews + :: Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) pullRequestReviews owner repo prid = - executeRequest' $ pullRequestReviewsR owner repo prid FetchAll - + executeRequest' $ pullRequestReviewsR owner repo prid FetchAll -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. With authentication. -- -- > pullRequestReviews' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) pullRequestReviews' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> Id PullRequest - -> IO (Either Error (Vector Review)) + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) pullRequestReviews' auth owner repo pr = - executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll - + executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll -- | Query a single pull request review. -- see -pullRequestReviewR :: Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> Request k Review +pullRequestReviewR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k Review pullRequestReviewR owner repo prid rid = - query - [ "repos" - , toPathPart owner - , toPathPart repo - , "pulls" - , toPathPart prid - , "reviews" - , toPathPart rid - ] - [] - + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + ] + [] -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. -- -- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview - :: Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> IO (Either Error Review) + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) pullRequestReview owner repo prid rid = - executeRequest' $ pullRequestReviewR owner repo prid rid - + executeRequest' $ pullRequestReviewR owner repo prid rid -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. With authentication. @@ -111,62 +107,59 @@ pullRequestReview owner repo prid rid = -- > pullRequestReview' (Just ("github-username", "github-password")) -- "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> IO (Either Error Review) + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) pullRequestReview' auth owner repo prid rid = - executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid - + executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid -- | Query the comments for a single pull request review. -- see pullRequestReviewCommentsR - :: Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> Request k [ReviewComment] + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k [ReviewComment] pullRequestReviewCommentsR owner repo prid rid = - query - [ "repos" - , toPathPart owner - , toPathPart repo - , "pulls" - , toPathPart prid - , "reviews" - , toPathPart rid - , "comments" - ] - [] - + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + , "comments" + ] + [] -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO - :: Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> IO (Either Error [ReviewComment]) + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO owner repo prid rid = - executeRequest' $ pullRequestReviewCommentsR owner repo prid rid - + executeRequest' $ pullRequestReviewCommentsR owner repo prid rid -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. With authentication. -- -- > pullRequestReviewComments' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> IO (Either Error [ReviewComment]) + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO' auth owner repo prid rid = - executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid + executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid From 82090eeea9827e5cd8a5b043f26632967ac3abed Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Thu, 13 Jul 2017 21:26:36 +0100 Subject: [PATCH 069/309] Change ordering of `ReviewComment` fields --- src/GitHub/Data/Reviews.hs | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 174457c7..2cede51a 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -55,7 +55,9 @@ instance FromJSON Review where o .: "id" data ReviewComment = ReviewComment - { reviewCommentBody :: !Text + { reviewCommentId :: !(Id ReviewComment) + , reviewCommentUser :: !SimpleUser + , reviewCommentBody :: !Text , reviewCommentUrl :: !URL , reviewCommentPullRequestReviewId :: !(Id Review) , reviewCommentDiffHunk :: !Text @@ -68,8 +70,6 @@ data ReviewComment = ReviewComment , reviewCommentUpdatedAt :: !UTCTime , reviewCommentHtmlUrl :: !URL , reviewCommentPullRequestUrl :: !URL - , reviewCommentUser :: !SimpleUser - , reviewCommentId :: !(Id ReviewComment) } deriving (Show, Generic) instance NFData ReviewComment where @@ -79,18 +79,19 @@ instance Binary ReviewComment instance FromJSON ReviewComment where parseJSON = - withObject "ReviewComment" $ \o -> - ReviewComment <$> 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" <*> - o .: "user" <*> - o .: "id" + 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" From 45f973934576c3b8d7bcd761e81a9f0cedcc4ab3 Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Fri, 14 Jul 2017 21:59:33 +0100 Subject: [PATCH 070/309] Rename PullRequests.ReviewComments -> PullRequests.Comments --- github.cabal | 2 +- samples/Pulls/{ReviewComments => Comments}/ListComments.hs | 2 +- samples/Pulls/{ReviewComments => Comments}/ShowComment.hs | 2 +- src/GitHub.hs | 2 +- .../Endpoints/PullRequests/{ReviewComments.hs => Comments.hs} | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) rename samples/Pulls/{ReviewComments => Comments}/ListComments.hs (92%) rename samples/Pulls/{ReviewComments => Comments}/ShowComment.hs (96%) rename src/GitHub/Endpoints/PullRequests/{ReviewComments.hs => Comments.hs} (97%) diff --git a/github.cabal b/github.cabal index 574a38ca..b19d4748 100644 --- a/github.cabal +++ b/github.cabal @@ -109,7 +109,7 @@ Library GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Reviews - GitHub.Endpoints.PullRequests.ReviewComments + GitHub.Endpoints.PullRequests.Comments GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/Comments/ListComments.hs similarity index 92% rename from samples/Pulls/ReviewComments/ListComments.hs rename to samples/Pulls/Comments/ListComments.hs index d16eb34a..b555301c 100644 --- a/samples/Pulls/ReviewComments/ListComments.hs +++ b/samples/Pulls/Comments/ListComments.hs @@ -1,6 +1,6 @@ module ListComments where -import qualified Github.PullRequests.ReviewComments as Github +import qualified Github.PullRequests.Comments as Github import Data.List main = do diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/Comments/ShowComment.hs similarity index 96% rename from samples/Pulls/ReviewComments/ShowComment.hs rename to samples/Pulls/Comments/ShowComment.hs index 95eb48e7..5714244e 100644 --- a/samples/Pulls/ReviewComments/ShowComment.hs +++ b/samples/Pulls/Comments/ShowComment.hs @@ -1,4 +1,4 @@ -module ShowComments where +module ShowComment where import qualified Github.PullRequests.ReviewComments as Github import Data.List diff --git a/src/GitHub.hs b/src/GitHub.hs index 2aadfdb4..62dad7ce 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -354,7 +354,7 @@ import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Reviews -import GitHub.Endpoints.PullRequests.ReviewComments +import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs similarity index 97% rename from src/GitHub/Endpoints/PullRequests/ReviewComments.hs rename to src/GitHub/Endpoints/PullRequests/Comments.hs index 32b84318..ccbf0d93 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -5,7 +5,7 @@ -- -- The pull request review comments API as described at -- . -module GitHub.Endpoints.PullRequests.ReviewComments ( +module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsIO, pullRequestCommentsR, pullRequestComment, From d2c763e216285dc2a3105c3f2f81c9f3167ae91f Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Sat, 15 Jul 2017 01:22:24 +0100 Subject: [PATCH 071/309] Make the PullRequests.Comments samples work --- samples/Pulls/Comments/ListComments.hs | 32 ++++++++++++++++---------- samples/Pulls/Comments/ShowComment.hs | 31 +++++++++++++++---------- 2 files changed, 39 insertions(+), 24 deletions(-) diff --git a/samples/Pulls/Comments/ListComments.hs b/samples/Pulls/Comments/ListComments.hs index b555301c..60ae4a07 100644 --- a/samples/Pulls/Comments/ListComments.hs +++ b/samples/Pulls/Comments/ListComments.hs @@ -1,21 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} module ListComments where -import qualified Github.PullRequests.Comments as Github -import Data.List +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.pullRequestComments "thoughtbot" "factory_girl" 256 + possiblePullRequestComments <- GitHub.pullRequestCommentsIO "thoughtbot" "factory_girl" (Id 256) case possiblePullRequestComments of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments + (Left err) -> putStrLn $ "Error: " <> show err + (Right comments) -> putStrLn . unpack $ foldr (\a b -> a <> "\n\n" <> b) "" (formatComment <$> comments) -formatComment :: Github.Comment -> String +formatComment :: GitHub.Comment -> Text formatComment comment = - "Author: " ++ (formatAuthor $ Github.commentUser comment) ++ - "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++ - (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ - "\n\n" ++ (Github.commentBody 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.Owner -> String +formatAuthor :: GitHub.SimpleUser -> Text formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl 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 index 5714244e..a0c2a2ba 100644 --- a/samples/Pulls/Comments/ShowComment.hs +++ b/samples/Pulls/Comments/ShowComment.hs @@ -1,22 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} module ShowComment where -import qualified Github.PullRequests.ReviewComments as Github -import Data.List +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" 301819 + possiblePullRequestComment <- GitHub.pullRequestComment "thoughtbot" "factory_girl" (Id 301819) case possiblePullRequestComment of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right comment) -> putStrLn $ formatComment comment + (Left err) -> putStrLn $ "Error: " <> show err + (Right comment) -> putStrLn . unpack $ formatComment comment -formatComment :: Github.Comment -> String +formatComment :: GitHub.Comment -> Text formatComment comment = - "Author: " ++ (formatAuthor $ Github.commentUser comment) ++ - "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++ - (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ - "\n\n" ++ (Github.commentBody 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.Owner -> String +formatAuthor :: GitHub.SimpleUser -> Text formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" + GitHub.untagName (GitHub.simpleUserLogin user) <> " (" <> GitHub.getUrl (GitHub.simpleUserUrl user) <> ")" +formatTime' :: (FormatTime t) => t -> String +formatTime' = formatTime defaultTimeLocale "%T, %F (%Z)" From 1b6db14b7910ffb0e0c54e4a3fd0b0223942875b Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Sat, 15 Jul 2017 00:33:59 +0100 Subject: [PATCH 072/309] Remove redundant import --- src/GitHub/Data/Reviews.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 2cede51a..44405531 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -2,7 +2,7 @@ module GitHub.Data.Reviews where import Data.Text (Text) import GitHub.Data.Definitions (SimpleUser) -import GitHub.Data.Id (Id(Id)) +import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () From ee8d1b924609ed8fcae5cca92017c9fc8dd9bdb1 Mon Sep 17 00:00:00 2001 From: TAKAHASHI Yuto Date: Wed, 30 Aug 2017 23:06:54 +0900 Subject: [PATCH 073/309] Add endpoints for (un)starring repositories --- samples/Activity/Starring/StarRepo.hs | 17 +++++++++++++++ samples/Activity/Starring/UnstarRepo.hs | 17 +++++++++++++++ src/GitHub.hs | 4 ++-- src/GitHub/Endpoints/Activity/Starring.hs | 26 +++++++++++++++++++++++ 4 files changed, 62 insertions(+), 2 deletions(-) create mode 100644 samples/Activity/Starring/StarRepo.hs create mode 100644 samples/Activity/Starring/UnstarRepo.hs diff --git a/samples/Activity/Starring/StarRepo.hs b/samples/Activity/Starring/StarRepo.hs new file mode 100644 index 00000000..452aaf7b --- /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 = "phadej" + 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..29d68dd1 --- /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 = "phadej" + 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/src/GitHub.hs b/src/GitHub.hs index e45282e6..d332d08b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -25,12 +25,12 @@ module GitHub ( -- Missing endpoints: -- -- * Check if you are starring a repository - -- * Star a repository - -- * Unstar a repository stargazersForR, reposStarredByR, myStarredR, myStarredAcceptStarR, + starRepoR, + unstarRepoR, -- ** Watching -- | See diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 7ca84c34..d934185b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -14,6 +14,10 @@ module GitHub.Endpoints.Activity.Starring ( myStarredR, myStarredAcceptStar, myStarredAcceptStarR, + starRepo, + starRepoR, + unstarRepo, + unstarRepoR, module GitHub.Data, ) where @@ -69,3 +73,25 @@ myStarredAcceptStar auth = -- See myStarredAcceptStarR :: FetchCount -> Request 'RA (Vector RepoStarred) myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] + +-- | Star a repo by the authenticated user. +starRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) +starRepo auth user repo = executeRequest auth $ starRepoR user repo + +-- | Star a repo by the authenticated user. +-- See +starRepoR :: Name Owner -> Name Repo -> Request 'RW () +starRepoR user repo = command Put' paths mempty + where + paths = ["user", "starred", toPathPart user, toPathPart repo] + +-- | Unstar a repo by the authenticated user. +unstarRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) +unstarRepo auth user repo = executeRequest auth $ unstarRepoR user repo + +-- | Unstar a repo by the authenticated user. +-- See +unstarRepoR :: Name Owner -> Name Repo -> Request 'RW () +unstarRepoR user repo = command Delete paths mempty + where + paths = ["user", "starred", toPathPart user, toPathPart repo] From 7755fc79a235261a34a3989a8d4435e01dfda8d2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 25 Sep 2017 16:40:32 +0300 Subject: [PATCH 074/309] Add Ord Request instance --- src/GitHub/Data/Request.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 5ca7556a..59e7e08f 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,6 +61,7 @@ data CommandMethod a where deriving (Typeable) deriving instance Eq (CommandMethod a) +deriving instance Ord (CommandMethod a) instance Show (CommandMethod a) where showsPrec _ Post = showString "Post" @@ -181,6 +182,9 @@ command m ps body = SimpleQuery (Command m ps body) deriving instance Eq a => Eq (Request k a) deriving instance Eq a => Eq (SimpleRequest k a) +deriving instance Ord a => Ord (Request k a) +deriving instance Ord a => Ord (SimpleRequest k a) + instance Show (SimpleRequest k a) where showsPrec d r = showParen (d > appPrec) $ case r of Query ps qs -> showString "Query " From 494b9bd8edb056af9e748176d2acff2af4eee63e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Sep 2017 11:15:28 +0300 Subject: [PATCH 075/309] Review PR events --- src/GitHub/Data/PullRequests.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index d5148d87..725e939b 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -160,6 +160,9 @@ data PullRequestEventType | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled + | PullRequestReviewRequested + | PullRequestReviewRequestRemoved + | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf @@ -284,6 +287,10 @@ instance FromJSON PullRequestEventType where parseJSON (String "unassigned") = pure PullRequestUnassigned parseJSON (String "labeled") = pure PullRequestLabeled parseJSON (String "unlabeled") = pure PullRequestUnlabeled + parseJSON (String "review_requested") = pure PullRequestReviewRequested + parseJSON (String "review_request_removed") = pure PullRequestReviewRequestRemoved + parseJSON (String "edited") = pure PullRequestEdited + parseJSON (String s) = fail $ "Unknown action type " <> T.unpack s parseJSON v = typeMismatch "Could not build a PullRequestEventType" v instance FromJSON PullRequestReference where From 7eb3d840e35b4319eca6c051eb5971cc3a468ab9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Sep 2017 11:16:45 +0300 Subject: [PATCH 076/309] Bump version to 0.17.0 --- CHANGELOG.md | 6 ++++++ github.cabal | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 42c63088..14ea611e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +Changes for 0.17.0 +- Add `Ord Request` instance +- Repository contents +- Repository starring endpoints +- Pull Request review endpoints + Changes for 0.16.0 - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR diff --git a/github.cabal b/github.cabal index b19d4748..d6c2ac2c 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.16.0 +version: 0.17.0 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full From 71f5b2ae1bb9fbb47d7540fe8c05cb12cc53e033 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Sep 2017 11:53:21 +0300 Subject: [PATCH 077/309] Fix compilation error --- src/GitHub/Data/PullRequests.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 725e939b..ab0d1976 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -26,6 +26,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) , simplePullRequestCreatedAt :: !UTCTime From 2038d037e47771ee60a937f931d5a0c4f5be9908 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Tue, 3 Oct 2017 11:07:15 -0400 Subject: [PATCH 078/309] Add requested reviewers field to pull request records --- fixtures/pull-request-opened.json | 311 +++++++++++++++++ fixtures/pull-request-review-requested.json | 351 ++++++++++++++++++++ github.cabal | 3 + spec/GitHub/PullRequestsSpec.hs | 54 ++- src/GitHub/Data/PullRequests.hs | 96 +++--- 5 files changed, 763 insertions(+), 52 deletions(-) create mode 100644 fixtures/pull-request-opened.json create mode 100644 fixtures/pull-request-review-requested.json 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-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/github.cabal b/github.cabal index d6c2ac2c..d403ac01 100644 --- a/github.cabal +++ b/github.cabal @@ -33,6 +33,8 @@ extra-source-files: fixtures/issue-search.json, fixtures/list-teams.json, fixtures/members-list.json, + fixtures/pull-request-opened.json, + fixtures/pull-request-review-requested.json, fixtures/user-organizations.json, fixtures/user.json @@ -184,6 +186,7 @@ test-suite github-test ghc-options: -Wall build-depends: base, base-compat, + bytestring, github, vector, unordered-containers, diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 78d1ab1c..609412eb 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where import qualified GitHub @@ -6,11 +7,15 @@ import qualified GitHub import Prelude () import Prelude.Compat -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +import qualified Data.Vector as V +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -28,8 +33,23 @@ spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts GitHub.FetchAll + GitHub.pullRequestsForR owner repo opts GitHub.FetchAll cs `shouldSatisfy` isRight + + describe "decoding pull request payloads" $ do + it "decodes a pull request 'opened' payload" $ do + V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) + `shouldBe` 0 + + V.length (GitHub.pullRequestRequestedReviewers pullRequestOpened) + `shouldBe` 0 + + it "decodes a pull request 'review_requested' payload" $ do + V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) + `shouldBe` 1 + + V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) + `shouldBe` 1 where repos = [ ("thoughtbot", "paperclip") @@ -37,3 +57,25 @@ spec = do , ("haskell", "cabal") ] opts = GitHub.stateClosed + + simplePullRequestOpened :: GitHub.SimplePullRequest + simplePullRequestOpened = + fromRightS (eitherDecodeStrict prOpenedPayload) + + pullRequestOpened :: GitHub.PullRequest + pullRequestOpened = + fromRightS (eitherDecodeStrict prOpenedPayload) + + simplePullRequestReviewRequested :: GitHub.SimplePullRequest + simplePullRequestReviewRequested = + fromRightS (eitherDecodeStrict prReviewRequestedPayload) + + pullRequestReviewRequested :: GitHub.PullRequest + pullRequestReviewRequested = + fromRightS (eitherDecodeStrict prReviewRequestedPayload) + + prOpenedPayload :: ByteString + prOpenedPayload = $(embedFile "fixtures/pull-request-opened.json") + + prReviewRequestedPayload :: ByteString + prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index ab0d1976..0a80ce7f 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -29,23 +29,24 @@ import Prelude () import qualified Data.Text as T data SimplePullRequest = SimplePullRequest - { simplePullRequestClosedAt :: !(Maybe UTCTime) - , simplePullRequestCreatedAt :: !UTCTime - , simplePullRequestUser :: !SimpleUser - , simplePullRequestPatchUrl :: !URL - , simplePullRequestState :: !IssueState - , simplePullRequestNumber :: !Int - , simplePullRequestHtmlUrl :: !URL - , simplePullRequestUpdatedAt :: !UTCTime - , simplePullRequestBody :: !(Maybe Text) - , simplePullRequestAssignees :: (Vector SimpleUser) - , simplePullRequestIssueUrl :: !URL - , simplePullRequestDiffUrl :: !URL - , simplePullRequestUrl :: !URL - , simplePullRequestLinks :: !PullRequestLinks - , simplePullRequestMergedAt :: !(Maybe UTCTime) - , simplePullRequestTitle :: !Text - , simplePullRequestId :: !(Id PullRequest) + { simplePullRequestClosedAt :: !(Maybe UTCTime) + , simplePullRequestCreatedAt :: !UTCTime + , simplePullRequestUser :: !SimpleUser + , simplePullRequestPatchUrl :: !URL + , simplePullRequestState :: !IssueState + , simplePullRequestNumber :: !Int + , simplePullRequestHtmlUrl :: !URL + , simplePullRequestUpdatedAt :: !UTCTime + , simplePullRequestBody :: !(Maybe Text) + , simplePullRequestAssignees :: (Vector SimpleUser) + , simplePullRequestRequestedReviewers :: (Vector SimpleUser) + , simplePullRequestIssueUrl :: !URL + , simplePullRequestDiffUrl :: !URL + , simplePullRequestUrl :: !URL + , simplePullRequestLinks :: !PullRequestLinks + , simplePullRequestMergedAt :: !(Maybe UTCTime) + , simplePullRequestTitle :: !Text + , simplePullRequestId :: !(Id PullRequest) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -53,35 +54,36 @@ instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest data PullRequest = PullRequest - { pullRequestClosedAt :: !(Maybe UTCTime) - , pullRequestCreatedAt :: !UTCTime - , pullRequestUser :: !SimpleUser - , pullRequestPatchUrl :: !URL - , pullRequestState :: !IssueState - , pullRequestNumber :: !Int - , pullRequestHtmlUrl :: !URL - , pullRequestUpdatedAt :: !UTCTime - , pullRequestBody :: !(Maybe Text) - , pullRequestAssignees :: (Vector SimpleUser) - , pullRequestIssueUrl :: !URL - , pullRequestDiffUrl :: !URL - , pullRequestUrl :: !URL - , pullRequestLinks :: !PullRequestLinks - , pullRequestMergedAt :: !(Maybe UTCTime) - , pullRequestTitle :: !Text - , pullRequestId :: !(Id PullRequest) - , pullRequestMergedBy :: !(Maybe SimpleUser) - , pullRequestChangedFiles :: !Int - , pullRequestHead :: !PullRequestCommit - , pullRequestComments :: !Count - , pullRequestDeletions :: !Count - , pullRequestAdditions :: !Count - , pullRequestReviewComments :: !Count - , pullRequestBase :: !PullRequestCommit - , pullRequestCommits :: !Count - , pullRequestMerged :: !Bool - , pullRequestMergeable :: !(Maybe Bool) - , pullRequestMergeableState :: !MergeableState + { pullRequestClosedAt :: !(Maybe UTCTime) + , pullRequestCreatedAt :: !UTCTime + , pullRequestUser :: !SimpleUser + , pullRequestPatchUrl :: !URL + , pullRequestState :: !IssueState + , pullRequestNumber :: !Int + , pullRequestHtmlUrl :: !URL + , pullRequestUpdatedAt :: !UTCTime + , pullRequestBody :: !(Maybe Text) + , pullRequestAssignees :: (Vector SimpleUser) + , pullRequestRequestedReviewers :: (Vector SimpleUser) + , pullRequestIssueUrl :: !URL + , pullRequestDiffUrl :: !URL + , pullRequestUrl :: !URL + , pullRequestLinks :: !PullRequestLinks + , pullRequestMergedAt :: !(Maybe UTCTime) + , pullRequestTitle :: !Text + , pullRequestId :: !(Id PullRequest) + , pullRequestMergedBy :: !(Maybe SimpleUser) + , pullRequestChangedFiles :: !Int + , pullRequestHead :: !PullRequestCommit + , pullRequestComments :: !Count + , pullRequestDeletions :: !Count + , pullRequestAdditions :: !Count + , pullRequestReviewComments :: !Count + , pullRequestBase :: !PullRequestCommit + , pullRequestCommits :: !Count + , pullRequestMerged :: !Bool + , pullRequestMergeable :: !(Maybe Bool) + , pullRequestMergeableState :: !MergeableState } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -197,6 +199,7 @@ instance FromJSON SimplePullRequest where <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -237,6 +240,7 @@ instance FromJSON PullRequest where <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From 7a7221568cf09ad332fa8a82d8a2a335386c2802 Mon Sep 17 00:00:00 2001 From: James Dabbs Date: Sun, 26 Feb 2017 16:47:15 -0500 Subject: [PATCH 079/309] Add create status endpoint --- github.cabal | 2 + spec/GitHub/CommitsSpec.hs | 4 +- src/GitHub/Data.hs | 6 ++ src/GitHub/Data/Statuses.hs | 81 ++++++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Statuses.hs | 23 ++++++++ 5 files changed, 113 insertions(+), 3 deletions(-) create mode 100644 src/GitHub/Data/Statuses.hs create mode 100644 src/GitHub/Endpoints/Repos/Statuses.hs diff --git a/github.cabal b/github.cabal index d6c2ac2c..75c1de42 100644 --- a/github.cabal +++ b/github.cabal @@ -86,6 +86,7 @@ Library GitHub.Data.Request GitHub.Data.Reviews GitHub.Data.Search + GitHub.Data.Statuses GitHub.Data.Teams GitHub.Data.URL GitHub.Data.Webhooks @@ -118,6 +119,7 @@ Library GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases + GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 2ca4f1a4..046fd36d 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -6,13 +6,12 @@ import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', - commitsForR, diffR, mkName) + commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) 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, @@ -59,6 +58,5 @@ spec = do 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 `shouldSatisfy` isRight diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 38d4efab..67fb6b09 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -16,6 +16,7 @@ module GitHub.Data ( mkTeamName, mkOrganizationName, mkRepoName, + mkCommitName, fromUserName, fromOrganizationName, -- ** Id @@ -48,6 +49,7 @@ module GitHub.Data ( 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 @@ -76,6 +78,7 @@ 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 @@ -110,6 +113,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/Statuses.hs b/src/GitHub/Data/Statuses.hs new file mode 100644 index 00000000..a6aae6ff --- /dev/null +++ b/src/GitHub/Data/Statuses.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module GitHub.Data.Statuses where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data StatusState + = StatusPending + | StatusSuccess + | StatusError + | StatusFailure + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData StatusState where rnf = genericRnf +instance Binary StatusState + +instance FromJSON StatusState where + parseJSON (String "pending") = pure StatusPending + parseJSON (String "success") = pure StatusSuccess + parseJSON (String "error") = pure StatusError + parseJSON (String "failure") = pure StatusFailure + parseJSON _ = fail "Could not build a StatusState" + +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 :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON Status where + parseJSON = withObject "Status" $ \o -> Status + <$> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "state" + <*> o .:? "target_url" + <*> o .:? "description" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "context" + <*> o .: "creator" + +data NewStatus = NewStatus + { newStatusState :: !StatusState + , newStatusTargetUrl :: !(Maybe URL) + , newStatusDescription :: !(Maybe Text) + , newStatusContext :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewStatus where rnf = genericRnf +instance Binary NewStatus + +instance ToJSON NewStatus where + toJSON (NewStatus s t d c) = object $ filter notNull $ + [ "state" .= s + , "target_url" .= t + , "description" .= d + , "context" .= c + ] + where + notNull (_, Null) = False + notNull (_, _) = True diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs new file mode 100644 index 00000000..e0858873 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -0,0 +1,23 @@ +-- +-- The repo statuses API as described on +-- . +module GitHub.Endpoints.Repos.Statuses ( + createStatus, + createStatusR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) +createStatus auth owner repo sha ns = + executeRequest auth $ createStatusR owner repo sha ns + +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] From e631f83f2574873c9648a25f7ecc65ae15d23bf6 Mon Sep 17 00:00:00 2001 From: James Dabbs Date: Sun, 26 Feb 2017 18:37:16 -0500 Subject: [PATCH 080/309] Add status-reading endpoints --- src/GitHub/Data/Statuses.hs | 33 ++++++++++++++++++++++++-- src/GitHub/Endpoints/Repos/Statuses.hs | 28 ++++++++++++++++++---- 2 files changed, 55 insertions(+), 6 deletions(-) diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index a6aae6ff..0b5e3b37 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -5,11 +5,16 @@ 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) + + data StatusState = StatusPending | StatusSuccess @@ -33,6 +38,7 @@ instance ToJSON StatusState where toJSON StatusError = String "error" toJSON StatusFailure = String "failure" + data Status = Status { statusCreatedAt :: !UTCTime , statusUpdatedAt :: !UTCTime @@ -42,7 +48,7 @@ data Status = Status , statusId :: !(Id Status) , statusUrl :: !URL , statusContext :: !(Maybe Text) - , statusCreator :: !SimpleUser + , statusCreator :: !(Maybe SimpleUser) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -56,7 +62,8 @@ instance FromJSON Status where <*> o .: "id" <*> o .: "url" <*> o .:? "context" - <*> o .: "creator" + <*> o .:? "creator" + data NewStatus = NewStatus { newStatusState :: !StatusState @@ -79,3 +86,25 @@ instance ToJSON NewStatus where where notNull (_, Null) = False notNull (_, _) = True + + +data CombinedStatus = CombinedStatus + { combinedStatusState :: !StatusState + , combinedStatusSha :: !(Name Commit) + , combinedStatusTotalCount :: !Int + , combinedStatusStatuses :: !(Vector Status) + , combinedStatusRepository :: !RepoRef + , combinedStatusCommitUrl :: !URL + , combinedStatusUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON CombinedStatus where + parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus + <$> o .: "state" + <*> o .: "sha" + <*> o .: "total_count" + <*> o .: "statuses" + <*> o .: "repository" + <*> o .: "commit_url" + <*> o .: "url" diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index e0858873..3bf16423 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -4,6 +4,10 @@ module GitHub.Endpoints.Repos.Statuses ( createStatus, createStatusR, + statusesFor, + statusesForR, + statusFor, + statusForR, module GitHub.Data ) where @@ -14,10 +18,26 @@ import Prelude () createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) createStatus auth owner repo sha ns = - executeRequest auth $ createStatusR owner repo sha ns + executeRequest auth $ createStatusR owner repo sha ns 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] + command Post parts . encode + where + parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] + +statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) +statusesFor auth user repo sha = + executeRequest auth $ statusesForR user repo sha FetchAll + +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"] [] + +statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) +statusFor auth user repo sha = + executeRequest auth $ statusForR user repo sha + +statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus +statusForR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] From d7d857270ff61b717e7ca09eac4c4ec5658321bc Mon Sep 17 00:00:00 2001 From: James Dabbs Date: Sun, 8 Oct 2017 11:26:42 -0400 Subject: [PATCH 081/309] Add documentation for status endpoints --- src/GitHub.hs | 7 +++++++ src/GitHub/Endpoints/Repos/Statuses.hs | 23 +++++++++++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index bd29d3da..4e1598db 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -328,6 +328,12 @@ module GitHub ( usersFollowingR, usersFollowedByR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- * Data definitions module GitHub.Data, -- * Request handling @@ -361,6 +367,7 @@ import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases +import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index 3bf16423..d25186d6 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -1,3 +1,7 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus -- -- The repo statuses API as described on -- . @@ -16,28 +20,47 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () +-- | Create a new status +-- +-- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +-- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) createStatus auth owner repo sha ns = executeRequest auth $ createStatusR owner repo sha ns +-- | Create a new status +-- See createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status createStatusR owner repo sha = command Post parts . encode where parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] +-- | All statuses for a commit +-- +-- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) statusesFor auth user repo sha = executeRequest auth $ statusesForR user repo sha FetchAll +-- | All statuses for a commit +-- See statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) statusesForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] +-- | The combined status for a specific commit +-- +-- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) statusFor auth user repo sha = executeRequest auth $ statusForR user repo sha +-- | The combined status for a specific commit +-- See statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus statusForR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] From d50776cfd72ec533a2c5667b755eba06de3c075f Mon Sep 17 00:00:00 2001 From: Hong Minhee Date: Fri, 13 Oct 2017 03:24:44 +0900 Subject: [PATCH 082/309] Endpoints for deleting issue comments --- src/GitHub/Endpoints/Issues/Comments.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 508fc642..2cbd7c5c 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -13,6 +13,8 @@ module GitHub.Endpoints.Issues.Comments ( comments', createComment, createCommentR, + deleteComment, + deleteCommentR, editComment, editCommentR, module GitHub.Data, @@ -88,3 +90,19 @@ editCommentR user repo commid body = command Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] + +-- | Delete a comment. +-- +-- > deleteComment (User (user, password)) user repo commentid +deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment + -> IO (Either Error ()) +deleteComment auth user repo commid = + executeRequest auth $ deleteCommentR user repo commid + +-- | Delete a comment. +-- See +deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> Request 'RW () +deleteCommentR user repo commid = + command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] From f63172e356081238f5e990f5273b8b550ef918d4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 Oct 2017 12:35:05 +0300 Subject: [PATCH 083/309] Allow http-types-0.10 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index d6c2ac2c..06d8b7da 100644 --- a/github.cabal +++ b/github.cabal @@ -142,7 +142,7 @@ Library http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.10, + http-types >=0.8.6 && <0.11, iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, From 422f3994049e08019d47669cfe1beb70a9b2fef3 Mon Sep 17 00:00:00 2001 From: TAKAHASHI Yuto Date: Tue, 31 Oct 2017 23:31:10 +0900 Subject: [PATCH 084/309] Add endpoints for deleting gists --- samples/Gists/DeleteGist.hs | 16 ++++++++++++++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Gists.hs | 13 +++++++++++++ 3 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 samples/Gists/DeleteGist.hs 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/src/GitHub.hs b/src/GitHub.hs index bd29d3da..b09cc062 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -57,9 +57,9 @@ module GitHub ( -- * Check if a gist is starred -- * Fork a gist -- * List gist forks - -- * Delete a gist gistsR, gistR, + deleteGistR, -- ** Comments -- | See diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 77d7bced..6242f611 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -11,6 +11,8 @@ module GitHub.Endpoints.Gists ( gist, gist', gistR, + deleteGist, + deleteGistR, module GitHub.Data, ) where @@ -55,3 +57,14 @@ gist = gist' Nothing gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] + +-- | Delete a gist by the authenticated user. +-- +-- > deleteGist ("github-username", "github-password") "225074" +deleteGist :: Auth -> Name Gist -> IO (Either Error ()) +deleteGist auth gid = executeRequest auth $ deleteGistR gid + +-- | Delete a gist by the authenticated user. +-- See +deleteGistR :: Name Gist -> Request 'RW () +deleteGistR gid = command Delete ["gists", toPathPart gid] mempty From ced200d496f624dc5e26d47e0fe43d625c36579b Mon Sep 17 00:00:00 2001 From: TAKAHASHI Yuto Date: Tue, 31 Oct 2017 23:11:47 +0900 Subject: [PATCH 085/309] Add endpoints for (un)starring gists --- samples/Gists/StarGist.hs | 16 ++++++++++++++++ samples/Gists/UnstarGist.hs | 16 ++++++++++++++++ src/GitHub.hs | 4 ++-- src/GitHub/Endpoints/Gists.hs | 26 ++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 samples/Gists/StarGist.hs create mode 100644 samples/Gists/UnstarGist.hs 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/src/GitHub.hs b/src/GitHub.hs index b09cc062..27ebbe67 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -52,13 +52,13 @@ module GitHub ( -- * 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 gistsR, gistR, + starGistR, + unstarGistR, deleteGistR, -- ** Comments diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 6242f611..cc23b2a9 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -11,6 +11,10 @@ module GitHub.Endpoints.Gists ( gist, gist', gistR, + starGist, + starGistR, + unstarGist, + unstarGistR, deleteGist, deleteGistR, module GitHub.Data, @@ -58,6 +62,28 @@ gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] +-- | Star a gist by the authenticated user. +-- +-- > starGist ("github-username", "github-password") "225074" +starGist :: Auth -> Name Gist -> IO (Either Error ()) +starGist auth gid = executeRequest auth $ starGistR gid + +-- | Star a gist by the authenticated user. +-- See +starGistR :: Name Gist -> Request 'RW () +starGistR gid = command Put' ["gists", toPathPart gid, "star"] mempty + +-- | Unstar a gist by the authenticated user. +-- +-- > unstarGist ("github-username", "github-password") "225074" +unstarGist :: Auth -> Name Gist -> IO (Either Error ()) +unstarGist auth gid = executeRequest auth $ unstarGistR gid + +-- | Unstar a gist by the authenticated user. +-- See +unstarGistR :: Name Gist -> Request 'RW () +unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty + -- | Delete a gist by the authenticated user. -- -- > deleteGist ("github-username", "github-password") "225074" From 316c66963d9afc50df4e66768abddb95162c4ad3 Mon Sep 17 00:00:00 2001 From: Hong Minhee Date: Wed, 1 Nov 2017 15:10:06 +0900 Subject: [PATCH 086/309] Re-export deleteCommentR from top GitHub module --- src/GitHub.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index bd29d3da..5b5357d9 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -106,12 +106,10 @@ module GitHub ( -- ** Comments -- | See -- - -- Missing endpoints: - -- - -- * Delete comment commentR, commentsR, createCommentR, + deleteCommentR, editCommentR, -- ** Events From 5bb76f2f265342ed639f8727f31bb9b2f795e1f6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 13:42:51 +0200 Subject: [PATCH 087/309] Add Repo.archived field --- src/GitHub/Data/Repos.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index cdd98ce9..63d58ea9 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -38,6 +38,7 @@ data Repo = Repo , repoFork :: !(Maybe Bool) , repoGitUrl :: !(Maybe URL) , repoPrivate :: !Bool + , repoArchived :: !Bool , repoCloneUrl :: !(Maybe URL) , repoSize :: !(Maybe Int) , repoUpdatedAt :: !(Maybe UTCTime) @@ -157,6 +158,7 @@ instance FromJSON Repo where <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" + <*> o .: "archived" <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" From 72ac073990e5ca48a042152e3dd10c9c1359a282 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 15:37:18 +0200 Subject: [PATCH 088/309] Add build-tool-depends, regenerate .travis.yml --- .travis.yml | 95 ++++++++++++++++++++++++++-------------------------- github.cabal | 1 + 2 files changed, 48 insertions(+), 48 deletions(-) diff --git a/.travis.yml b/.travis.yml index 82db014c..8a4d5571 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,6 @@ # This Travis job script has been generated by a script via # -# make_travis_yml_2.hs 'github.cabal' +# make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' # # For more information, see https://github.com/hvr/multi-ghc-travis # @@ -10,11 +10,14 @@ sudo: false git: submodules: false # whether to recursively clone submodules +branches: + only: + - master + cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store - - $HOME/.local/bin before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log @@ -41,59 +44,55 @@ matrix: addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} before_install: - - HC=${CC} - - unset CC - - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH - - PKGNAME='github' + - HC=${CC} + - HCPKG=${HC/ghc/ghc-pkg} + - unset CC + - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH install: - - ROOTDIR=$(pwd) - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - travis_retry cabal update -v - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - sh install-hspec-discover.sh # TEMP, before we get cabal new-install - - rm -fv cabal.project.local - - "echo 'packages: .' > cabal.project" - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - HADDOCK=${HADDOCK-true} + - INSTALLED=${INSTALLED-true} + - travis_retry cabal update -v + - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - "echo 'packages: .' > cabal.project" + - if [ -f "./configure.ac" ]; then + (cd "."; autoreconf -i); + fi + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all + - rm -rf "."/.ghc.environment.* "."/dist + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # 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: - - if [ -f configure.ac ]; then autoreconf -i; fi - - rm -rf .ghc.environment.* dist/ - - cabal sdist # test that a source-distribution can be generated - - cd dist/ - - SRCTAR=(${PKGNAME}-*.tar.gz) - - SRC_BASENAME="${SRCTAR/%.tar.gz}" - - tar -xvf "./$SRC_BASENAME.tar.gz" - - cd "$SRC_BASENAME/" -## from here on, CWD is inside the extracted source-tarball - - rm -fv cabal.project.local - - "echo 'packages: . samples' > cabal.project" - - cp -r $ROOTDIR/samples . - # this builds all libraries and executables (without tests/benchmarks) - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - # this builds all libraries and executables (including tests/benchmarks) - # - rm -rf ./dist-newstyle + # test that source-distributions can be generated + - (cd "."; cabal sdist) + - mv "."/dist/github-*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} + - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - "printf 'packages: github-*/*.cabal\n' > cabal.project" + # this builds all libraries and executables (without tests/benchmarks) + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - # build & run tests - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + # Build with installed constraints for packages in global-db + - if $INSTALLED; then + echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; + else echo "Not building with installed constraints"; fi - # run samples - - for sample in show-user list-followers list-following operational; do - echo "=== SAMPLE $sample ==="; - $(find dist-newstyle/ -type f -name github-$sample); - done + # build & run tests, build benchmarks + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi -# EOF + # haddock + - rm -rf ./dist-newstyle + - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi -branches: - only: - - master +# REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] +# EOF diff --git a/github.cabal b/github.cabal index 06d8b7da..2a3e190e 100644 --- a/github.cabal +++ b/github.cabal @@ -182,6 +182,7 @@ test-suite github-test GitHub.EventsSpec main-is: Spec.hs ghc-options: -Wall + build-tool-depends: hspec-discover:hspec-discover build-depends: base, base-compat, github, From b2778cc3c2ed4da36aa03c35552af3b018ab54b8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 17:56:16 +0200 Subject: [PATCH 089/309] Remove install-hspec-discover.sh [ci skip] --- install-hspec-discover.sh | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 install-hspec-discover.sh diff --git a/install-hspec-discover.sh b/install-hspec-discover.sh deleted file mode 100644 index 17a3a34a..00000000 --- a/install-hspec-discover.sh +++ /dev/null @@ -1,18 +0,0 @@ -#!/bin/sh - -set -ex - -if [ ! -e $HOME/.local/bin/hspec-discover ]; then - # Fetch the source - cabal get hspec-discover-2.4.4 - cd hspec-discover-2.4.4 - - # Set-up project - echo 'packages: .' > cabal.project - - # build exe - cabal new-build hspec-discover:exe:hspec-discover - - # copy executable to $HOME/.local/bin - cp $(find dist-newstyle -name hspec-discover -type f) $HOME/.local/bin -fi From be2f210aaa4e669a6929b2885442ba822ece1334 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 18:52:32 +0200 Subject: [PATCH 090/309] Lenient archived parsing --- src/GitHub/Data/Repos.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 63d58ea9..34fc81c8 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -158,7 +158,7 @@ instance FromJSON Repo where <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" - <*> o .: "archived" + <*> o .:? "archived" .!= False <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" From 0cb267533216bc25e4e5c1d5ecf9a7431465304c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 18:00:34 +0200 Subject: [PATCH 091/309] Bump version to 0.18 --- CHANGELOG.md | 14 ++++++++++++++ github.cabal | 2 +- 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 14ea611e..7857c4ee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +Changes for 0.18 +- Endpoints for deleting issue comments. + [#294](https://github.com/phadej/github/pull/294) +- Endpoints for (un)starring gists. + [#296](https://github.com/phadej/github/pull/296) +- Add `archived` field to `Repo`. + [#298](https://github.com/phadej/github/pull/298) +- Update dependencies. + [#295](https://github.com/phadej/github/pull/295) +- Add Statuses endpoints. + [#268](https://github.com/phadej/github/pull/268) +- Add requested reviewers field to pull request records. + [#292](https://github.com/phadej/github/pull/292) + Changes for 0.17.0 - Add `Ord Request` instance - Repository contents diff --git a/github.cabal b/github.cabal index b4209f3e..1eec1f2d 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.17.0 +version: 0.18 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full From a93a495b7883a454010fb46d30e4a0003096a9de Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Dec 2017 00:39:53 +0200 Subject: [PATCH 092/309] Allow http-types-0.11 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 1eec1f2d..c7e156b4 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,6 @@ name: github version: 0.18 +x-revision: 1 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -146,7 +147,7 @@ Library http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.11, + http-types >=0.8.6 && <0.12, iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, From 3470ed93214435889ba462aadd80cfa263acace3 Mon Sep 17 00:00:00 2001 From: MM Date: Thu, 28 Dec 2017 07:19:42 +0100 Subject: [PATCH 093/309] userRepo should be repository --- samples/Repos/ShowRepo.hs | 2 +- src/GitHub/Endpoints/Repos.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs index fb63c497..5007cfdc 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -5,7 +5,7 @@ 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 diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index e9261db3..d9ad44a1 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -136,14 +136,14 @@ organizationReposR org publicity = -- | Details on a specific repo, given the owner and repo name. -- --- > userRepo "mike-burns" "github" +-- > repository "mike-burns" "github" repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- --- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github" +-- > repository' (Just (BasicAuth (user, password))) "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo From 8f543cdc07876bfb7b924d3722e3dbc1df4b02ca Mon Sep 17 00:00:00 2001 From: Ryan Trinkle Date: Sat, 30 Dec 2017 19:18:10 -0500 Subject: [PATCH 094/309] Add "Get archive link" API See https://developer.github.com/v3/repos/contents/#get-archive-link --- src/GitHub/Data/Repos.hs | 11 ++++++++ src/GitHub/Data/Request.hs | 7 ++++++ src/GitHub/Endpoints/Repos/Contents.hs | 30 ++++++++++++++++++++++ src/GitHub/Request.hs | 35 +++++++++++++++++++++++--- 4 files changed, 80 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 34fc81c8..c476fbbb 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -14,6 +14,7 @@ module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +import GitHub.Data.Request (IsPathPart (..)) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -257,3 +258,13 @@ instance FromJSON a => FromJSON (HM.HashMap Language a) where mapKey f = HM.fromList . map (first f) . HM.toList #endif #endif + +data ArchiveFormat + = ArchiveFormatTarball -- ^ ".tar.gz" format + | ArchiveFormatZipball -- ^ ".zip" format + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + +instance IsPathPart ArchiveFormat where + toPathPart af = case af of + ArchiveFormatTarball -> "tarball" + ArchiveFormatZipball -> "zipball" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 59e7e08f..d95af9f5 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -36,6 +36,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ @@ -141,6 +142,7 @@ data Request (k :: RW) a where SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a + RedirectQuery :: SimpleRequest k () -> Request k URI deriving (Typeable) data SimpleRequest (k :: RW) a where @@ -218,6 +220,8 @@ instance Show (Request k a) where . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) req + RedirectQuery req -> showString "Redirect " + . showsPrec (appPrec + 1) req where appPrec = 10 :: Int @@ -249,3 +253,6 @@ instance Hashable (Request k a) where salt `hashWithSalt` (2 :: Int) `hashWithSalt` h `hashWithSalt` req + hashWithSalt salt (RedirectQuery req) = + salt `hashWithSalt` (3 :: Int) + `hashWithSalt` req diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 98c292a9..d424b0c3 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -13,6 +13,9 @@ module GitHub.Endpoints.Repos.Contents ( readmeFor, readmeFor', readmeForR, + archiveFor, + archiveFor', + archiveForR, -- ** Create createFile, @@ -34,7 +37,9 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () +import Data.Maybe (maybeToList) import qualified Data.Text.Encoding as TE +import Network.URI (URI) -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- @@ -79,6 +84,31 @@ readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = query ["repos", toPathPart user, toPathPart repo, "readme"] [] +-- | The archive of a repo, given the repo owner, name, and archive type +-- +-- > archiveFor "thoughtbot" "paperclip" ArchiveFormatTarball Nothing +archiveFor :: Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) +archiveFor = archiveFor' Nothing + +-- | The archive of a repo, given the repo owner, name, and archive type +-- With Authentication +-- +-- > archiveFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" ArchiveFormatTarball Nothing +archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) +archiveFor' auth user repo path ref = + executeRequestMaybe auth $ archiveForR user repo path ref + +archiveForR + :: Name Owner + -> Name Repo + -> ArchiveFormat -- ^ The type of archive to retrieve + -> Maybe Text -- ^ Git commit + -> Request k URI +archiveForR user repo format ref = + RedirectQuery $ Query path [] + where + path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref + -- | Create a file. createFile :: Auth diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 5629e61c..e9f9cddd 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -59,6 +59,7 @@ import Control.Monad.Except (MonadError (..)) import Control.Monad.Error (MonadError (..)) #endif +import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) @@ -67,13 +68,13 @@ import Data.List (find) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), - applyBasicAuth, httpLbs, method, newManager, requestBody, - requestHeaders, setQueryString) + applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount, + requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) 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, Status (..)) -import Network.URI (URI) +import Network.URI (URI, parseURIReference, relativeTo) #if !MIN_VERSION_http_client(0,5,0) import qualified Control.Exception as E @@ -82,6 +83,7 @@ import Network.HTTP.Types (ResponseHeaders) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP @@ -125,6 +127,9 @@ executeRequestWithMgr mgr auth req = runExceptT $ do performHttpReq httpReq (StatusQuery sm _) = do res <- httpLbs' httpReq parseStatus sm . responseStatus $ res + performHttpReq httpReq (RedirectQuery _) = do + res <- httpLbs' httpReq + parseRedirect (getUri httpReq) res performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b performHttpReq' httpReq Query {} = do @@ -172,6 +177,9 @@ executeRequestWithMgr' mgr req = runExceptT $ do performHttpReq httpReq (StatusQuery sm _) = do res <- httpLbs' httpReq parseStatus sm . responseStatus $ res + performHttpReq httpReq (RedirectQuery _) = do + res <- httpLbs' httpReq + parseRedirect (getUri httpReq) res performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b performHttpReq' httpReq Query {} = do @@ -222,6 +230,9 @@ makeHttpRequest auth r = case r of HeaderQuery h req -> do req' <- makeHttpSimpleRequest auth req return $ req' { requestHeaders = h <> requestHeaders req' } + RedirectQuery req -> do + req' <- makeHttpSimpleRequest auth req + return $ setRequestIgnoreStatus $ req' { redirectCount = 0 } makeHttpSimpleRequest :: MonadThrow m @@ -328,6 +339,24 @@ parseStatus m (Status sci _) = where err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) +-- | Helper for handling of 'RequestRedirect'. +-- +-- @ +-- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI +parseRedirect originalUri rsp = do + let status = responseStatus rsp + when (statusCode status /= 302) $ + throwError $ ParseError $ "invalid status: " <> T.pack (show status) + loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp + case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of + Nothing -> throwError $ ParseError $ + "location header does not contain a URI: " <> T.pack (show loc) + Just uri -> return $ uri `relativeTo` originalUri + where + noLocation = throwError $ ParseError "no location header in response" + -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ From ee04b14828f8c6ef5624cf96ae4b6c29154f457c Mon Sep 17 00:00:00 2001 From: iphydf Date: Sun, 7 Jan 2018 18:49:13 +0000 Subject: [PATCH 095/309] Add "behind" mergeable_state. --- src/GitHub/Data/Options.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 274d4b2a..84105277 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -96,6 +96,7 @@ data MergeableState | StateDirty | StateUnstable | StateBlocked + | StateBehind deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -105,6 +106,7 @@ instance ToJSON MergeableState where toJSON StateDirty = String "dirty" toJSON StateUnstable = String "unstable" toJSON StateBlocked = String "blocked" + toJSON StateBehind = String "behind" instance FromJSON MergeableState where parseJSON (String "unknown") = pure StateUnknown @@ -112,6 +114,7 @@ instance FromJSON MergeableState where parseJSON (String "dirty") = pure StateDirty parseJSON (String "unstable") = pure StateUnstable parseJSON (String "blocked") = pure StateBlocked + parseJSON (String "behind") = pure StateBehind parseJSON v = typeMismatch "MergeableState" v instance NFData MergeableState where rnf = genericRnf From a6d421df43da2fd998cffc7eef71aed46d70e1cd Mon Sep 17 00:00:00 2001 From: iphydf Date: Thu, 11 Jan 2018 11:49:06 +0000 Subject: [PATCH 096/309] Make "repo" in PullRequestCommit nullable. In rare cases, the repo can become null. Fixes #310. --- src/GitHub/Data/PullRequests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0a80ce7f..e40199f5 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -136,7 +136,7 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitRef :: !Text , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser - , pullRequestCommitRepo :: !Repo + , pullRequestCommitRepo :: !(Maybe Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From ddf5a0db2d304be1cbd93af91c2d5ba3992eea34 Mon Sep 17 00:00:00 2001 From: Myron Wu Date: Mon, 15 Jan 2018 22:57:08 -0800 Subject: [PATCH 097/309] Fixing isPullRequestMerged and other is* predicates by changing expectation to http 204 instead of 202 --- spec/GitHub/PullRequestsSpec.hs | 8 ++++++++ src/GitHub/Data/Request.hs | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 609412eb..fbea7c7a 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,6 +3,7 @@ module GitHub.PullRequestsSpec where import qualified GitHub +import GitHub.Data.Id (Id(Id)) import Prelude () import Prelude.Compat @@ -50,6 +51,13 @@ spec = do V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 + + describe "checking if a pull request is merged" $ do + it "works" $ withAuth $ \auth -> do + b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (Id 14) + b `shouldSatisfy` isRight + fromRightS b `shouldBe` True + where repos = [ ("thoughtbot", "paperclip") diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 59e7e08f..4e693436 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -158,7 +158,7 @@ type StatusMap a = [(Int, a)] statusOnlyOk :: StatusMap Bool statusOnlyOk = - [ (202, True) + [ (204, True) , (404, False) ] From 2374f383ed7f66493413375b2850f29f7c18ab76 Mon Sep 17 00:00:00 2001 From: Myron Wu Date: Tue, 16 Jan 2018 22:07:43 -0800 Subject: [PATCH 098/309] Adding "Check membership" API --- src/GitHub.hs | 3 ++- src/GitHub/Endpoints/Organizations/Members.hs | 25 +++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index a68c6c80..42b4ddcc 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -158,9 +158,10 @@ module GitHub ( -- ** Members -- | See -- - -- Missing endpoints: All except /Members List/ + -- Missing endpoints: All except /Members List/ and /Check Membership/ membersOfR, membersOfWithR, + isMemberOfR, -- ** Teams -- | See diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index acb0d366..d2ef4a3b 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -10,6 +10,9 @@ module GitHub.Endpoints.Organizations.Members ( membersOf', membersOfR, membersOfWithR, + isMemberOf, + isMemberOf', + isMemberOfR, module GitHub.Data, ) where @@ -54,3 +57,25 @@ membersOfWithR org f r = OrgMemberRoleAll -> "all" OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" + +-- | Check if a user is a member of an organization, +-- | with or without authentication. +-- +-- > isMemberOf' (Just $ OAuth "token") "phadej" "haskell-infra" +isMemberOf' :: Maybe Auth -> Name User -> Name Organization -> IO (Either Error Bool) +isMemberOf' auth user org = + executeRequestMaybe auth $ isMemberOfR user org + +-- | Check if a user is a member of an organization, +-- | without authentication. +-- +-- > isMemberOf "phadej" "haskell-infra" +isMemberOf :: Name User -> Name Organization -> IO (Either Error Bool) +isMemberOf = isMemberOf' Nothing + +-- | Check if a user is a member of an organization. +-- +-- See +isMemberOfR :: Name User -> Name Organization -> Request k Bool +isMemberOfR user org = StatusQuery statusOnlyOk $ + Query [ "orgs", toPathPart org, "members", toPathPart user ] [] \ No newline at end of file From bf59f09d3b3f61dba4784baa421a8f67b1094d1b Mon Sep 17 00:00:00 2001 From: Myron Wu Date: Thu, 18 Jan 2018 00:15:01 -0800 Subject: [PATCH 099/309] Adding read-only parts of emails endpoint --- github.cabal | 2 ++ samples/Users/Emails/ListEmails.hs | 17 +++++++++++ src/GitHub.hs | 12 ++++++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/Email.hs | 39 ++++++++++++++++++++++++ src/GitHub/Endpoints/Users/Emails.hs | 45 ++++++++++++++++++++++++++++ 6 files changed, 117 insertions(+) create mode 100644 samples/Users/Emails/ListEmails.hs create mode 100644 src/GitHub/Data/Email.hs create mode 100644 src/GitHub/Endpoints/Users/Emails.hs diff --git a/github.cabal b/github.cabal index c7e156b4..74ec11c2 100644 --- a/github.cabal +++ b/github.cabal @@ -75,6 +75,7 @@ Library GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Email GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData @@ -126,6 +127,7 @@ Library GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users + GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers GitHub.Request 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/src/GitHub.hs b/src/GitHub.hs index 42b4ddcc..92c37e73 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -315,6 +315,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 -- @@ -370,5 +381,6 @@ import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users +import GitHub.Endpoints.Users.Emails import GitHub.Endpoints.Users.Followers import GitHub.Request diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 67fb6b09..2504d841 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -37,6 +37,7 @@ module GitHub.Data ( module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, + module GitHub.Data.Email, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, @@ -64,6 +65,7 @@ import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys +import GitHub.Data.Email import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs new file mode 100644 index 00000000..23f738c6 --- /dev/null +++ b/src/GitHub/Data/Email.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Email where + +import GitHub.Internal.Prelude +import Prelude () + +data EmailVisibility + = EmailVisibilityPrivate + | EmailVisibilityPublic + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData EmailVisibility where rnf = genericRnf +instance Binary EmailVisibility + +instance FromJSON EmailVisibility where + parseJSON (String "private") = pure EmailVisibilityPrivate + parseJSON (String "public") = pure EmailVisibilityPublic + parseJSON _ = fail "Could not build an EmailVisibility" + +data Email = Email + { emailAddress :: !Text + , emailVerified :: !Bool + , emailPrimary :: !Bool + , emailVisibility :: !(Maybe EmailVisibility) + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Email where rnf = genericRnf +instance Binary Email + +instance FromJSON Email where + parseJSON = withObject "Email" $ \o -> Email + <$> o .: "email" + <*> o .: "verified" + <*> o .: "primary" + <*> o .:? "visibility" diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs new file mode 100644 index 00000000..c432aae6 --- /dev/null +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -0,0 +1,45 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The user emails API as described on +-- . +module GitHub.Endpoints.Users.Emails ( + currentUserEmails', + currentUserEmailsR, + currentUserPublicEmails', + currentUserPublicEmailsR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | List email addresses for the authenticated user. +-- +-- > currentUserEmails' (OAuth "token") +currentUserEmails' :: Auth -> IO (Either Error (Vector Email)) +currentUserEmails' auth = + executeRequest auth $ currentUserEmailsR FetchAll + +-- | List email addresses. +-- See +currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) +currentUserEmailsR = + pagedQuery ["user", "emails"] [] + +-- | List public email addresses for the authenticated user. +-- +-- > currentUserPublicEmails' (OAuth "token") +currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email)) +currentUserPublicEmails' auth = + executeRequest auth $ currentUserPublicEmailsR FetchAll + +-- | List public email addresses. +-- See +currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) +currentUserPublicEmailsR = + pagedQuery ["user", "public_emails"] [] From 8af33743cbc4ae3bbc0a63f0f92d7a3de3e1a7ac Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 28 Jan 2018 15:17:04 +0200 Subject: [PATCH 100/309] Prepare for 0.19 release [wip] --- .travis.yml | 43 +++++++++++++++++++++++++++---------------- CHANGELOG.md | 3 +++ github.cabal | 9 ++++----- 3 files changed, 34 insertions(+), 21 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8a4d5571..b277ed12 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,6 @@ # This Travis job script has been generated by a script via # -# make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' +# runghc make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' # # For more information, see https://github.com/hvr/multi-ghc-travis # @@ -28,6 +28,8 @@ before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + - rm -rfv $HOME/.cabal/packages/head.hackage + matrix: include: - compiler: "ghc-7.8.4" @@ -39,15 +41,19 @@ matrix: - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.1" + - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}} before_install: - HC=${CC} - HCPKG=${HC/ghc/ghc-pkg} - unset CC - - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - ROOTDIR=$(pwd) + - mkdir -p $HOME/.local/bin + - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - echo $HCNUMVER install: - cabal --version @@ -56,12 +62,15 @@ install: - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - INSTALLED=${INSTALLED-true} + - GHCHEAD=${GHCHEAD-false} - travis_retry cabal update -v - - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - rm -fv cabal.project.local - - "echo 'packages: .' > cabal.project" + - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" + - rm -fv cabal.project cabal.project.local + - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' + - "printf 'packages: \".\"\\n' > cabal.project" + - cat cabal.project - if [ -f "./configure.ac" ]; then - (cd "."; autoreconf -i); + (cd "." && autoreconf -i); fi - rm -f cabal.project.freeze - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all @@ -73,26 +82,28 @@ install: # any command which exits with a non-zero exit code causes the build to fail. script: # test that source-distributions can be generated - - (cd "."; cabal sdist) + - (cd "." && cabal sdist) - mv "."/dist/github-*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} + - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - "printf 'packages: github-*/*.cabal\n' > cabal.project" + - "printf 'packages: github-*/*.cabal\\n' > cabal.project" + - cat cabal.project # this builds all libraries and executables (without tests/benchmarks) - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all # Build with installed constraints for packages in global-db - - if $INSTALLED; then - echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; - else echo "Not building with installed constraints"; fi + - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi + + # cabal check + - (cd github-* && cabal check) # haddock - rm -rf ./dist-newstyle - - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi + - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi # REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] # EOF diff --git a/CHANGELOG.md b/CHANGELOG.md index 7857c4ee..d45dcdc8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +Changes for 0.19 +- TBW + Changes for 0.18 - Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) diff --git a/github.cabal b/github.cabal index 74ec11c2..54e19087 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github -version: 0.18 -x-revision: 1 +version: 0.19 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -26,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 cabal-version: >=1.10 extra-source-files: README.md, @@ -149,13 +148,13 @@ Library http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.12, + http-types >=0.12 && <0.13, 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.9, + time >=1.4 && <1.10, transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, From 405f18676b720771db7486b6e43820911bd459d8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:14:47 +0200 Subject: [PATCH 101/309] Fix #301: Update EventType enumeration --- src/GitHub/Data/Issues.hs | 96 +++++++++++++++++++++++---------------- 1 file changed, 58 insertions(+), 38 deletions(-) diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index e30a2c03..66a5e0da 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -79,25 +79,35 @@ data IssueComment = IssueComment instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment +-- | See data EventType - = Mentioned -- ^ The actor was @mentioned in an issue body. - | Subscribed -- ^ The actor subscribed to receive notifications for an issue. - | Unsubscribed -- ^ The issue was unsubscribed from by the actor. - | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. - | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. - | Assigned -- ^ The issue was assigned to the actor. - | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. - | Reopened -- ^ The issue was reopened by the actor. - | ActorUnassigned -- ^ The issue was unassigned to the actor - | Labeled -- ^ A label was added to the issue. - | Unlabeled -- ^ A label was removed from the issue. - | Milestoned -- ^ The issue was added to a milestone. - | Demilestoned -- ^ The issue was removed from a milestone. - | Renamed -- ^ The issue title was changed. - | Locked -- ^ The issue was locked by the actor. - | Unlocked -- ^ The issue was unlocked by the actor. - | HeadRefDeleted -- ^ The pull request’s branch was deleted. - | HeadRefRestored -- ^ The pull request’s branch was restored. + = Mentioned -- ^ The actor was @mentioned in an issue body. + | Subscribed -- ^ The actor subscribed to receive notifications for an issue. + | Unsubscribed -- ^ The issue was unsubscribed from by the actor. + | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. + | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. + | Assigned -- ^ The issue was assigned to the actor. + | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. + | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. + | ReviewRequested -- ^ The actor requested review from the subject on this pull request. + | ReviewDismissed -- ^ The actor dismissed a review from the pull request. + | ReviewRequestRemoved -- ^ The actor removed the review request for the subject on this pull request. + | MarkedAsDuplicate -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request. + | UnmarkedAsDuplicate -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate. + | AddedToProject -- ^ The issue was added to a project board. + | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. + | RemovedFromProject -- ^ The issue was removed from a project board. + | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf @@ -116,7 +126,7 @@ data IssueEvent = IssueEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueEvent where rnf = genericRnf -instance Binary IssueEvent +instance Binary IssueEvent instance FromJSON IssueEvent where parseJSON = withObject "Event" $ \o -> IssueEvent @@ -129,25 +139,35 @@ instance FromJSON IssueEvent where <*> o .:? "issue" 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" + parseJSON = withText "EventType" $ \t -> case 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 " ++ show t instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment From 3085a784a07d54f6eb6fb212c2cae80768e08334 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:34:05 +0200 Subject: [PATCH 102/309] Fix #302. Add issueEventLabel --- src/GitHub/Data/Definitions.hs | 4 ++-- src/GitHub/Data/Issues.hs | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index c2c172d5..ea7ed2ea 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -18,7 +18,7 @@ import qualified Data.Text as T import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) -import GitHub.Data.URL (URL) +import GitHub.Data.URL (URL (..)) -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. @@ -254,5 +254,5 @@ instance Binary IssueLabel instance FromJSON IssueLabel where parseJSON = withObject "IssueLabel" $ \o -> IssueLabel <$> o .: "color" - <*> o .: "url" + <*> o .:? "url" .!= URL "" -- in events there aren't URL <*> o .: "name" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 66a5e0da..cb3981fb 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -21,7 +21,7 @@ data Issue = Issue , issueEventsUrl :: !URL , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) - , issueLabels :: (Vector IssueLabel) + , issueLabels :: !(Vector IssueLabel) , issueNumber :: !Int , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser @@ -122,6 +122,7 @@ data IssueEvent = IssueEvent , issueEventCreatedAt :: !UTCTime , issueEventId :: !Int , issueEventIssue :: !(Maybe Issue) + , issueEventLabel :: !(Maybe IssueLabel) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -137,6 +138,7 @@ instance FromJSON IssueEvent where <*> o .: "created_at" <*> o .: "id" <*> o .:? "issue" + <*> o .:? "label" instance FromJSON EventType where parseJSON = withText "EventType" $ \t -> case t of From 1c973ffaa67ed1e890fe3e3da826a497c534741a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:36:57 +0200 Subject: [PATCH 103/309] Add list pending organization invitations req --- github.cabal | 1 + src/GitHub.hs | 1 + src/GitHub/Data.hs | 2 + src/GitHub/Data/Invitation.hs | 57 +++++++++++++++++++ src/GitHub/Endpoints/Organizations/Members.hs | 9 ++- 5 files changed, 69 insertions(+), 1 deletion(-) create mode 100644 src/GitHub/Data/Invitation.hs diff --git a/github.cabal b/github.cabal index 54e19087..a4745206 100644 --- a/github.cabal +++ b/github.cabal @@ -79,6 +79,7 @@ Library GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id + GitHub.Data.Invitation GitHub.Data.Issues GitHub.Data.Milestone GitHub.Data.Name diff --git a/src/GitHub.hs b/src/GitHub.hs index 92c37e73..8cf6cbdf 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -162,6 +162,7 @@ module GitHub ( membersOfR, membersOfWithR, isMemberOfR, + orgInvitationsR, -- ** Teams -- | See diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 2504d841..1c935721 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -41,6 +41,7 @@ module GitHub.Data ( 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, @@ -70,6 +71,7 @@ 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 diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs new file mode 100644 index 00000000..b4126ccc --- /dev/null +++ b/src/GitHub/Data/Invitation.hs @@ -0,0 +1,57 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Invitation where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Internal.Prelude +import Prelude () + +data Invitation = Invitation + { invitationId :: !(Id Invitation) + -- TODO: technically either one should be, maybe both. use `these` ? + , invitationLogin :: !(Maybe (Name User)) + , invitationEmail :: !(Maybe Text) + , invitationRole :: !InvitationRole + , invitationCreatedAt :: !UTCTime + , inviter :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Invitation where rnf = genericRnf +instance Binary Invitation + +instance FromJSON Invitation where + parseJSON = withObject "Invitation" $ \o -> Invitation + <$> o .: "id" + <*> o .:? "login" + <*> o .:? "email" + <*> o .: "role" + <*> o .: "created_at" + <*> o .: "inviter" + + +data InvitationRole + = InvitationRoleDirectMember + | InvitationRoleAdmin + | InvitationRoleBillingManager + | InvitationRoleHiringManager + | InvitationRoleReinstate + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData InvitationRole where rnf = genericRnf +instance Binary InvitationRole + +instance FromJSON InvitationRole where + parseJSON = withText "InvirationRole" $ \t -> case t of + "direct_member" -> pure InvitationRoleDirectMember + "admin" -> pure InvitationRoleAdmin + "billing_manager" -> pure InvitationRoleBillingManager + "hiring_manager" -> pure InvitationRoleHiringManager + "reinstate" -> pure InvitationRoleReinstate + _ -> fail $ "Invalid role " ++ show t diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index d2ef4a3b..d5b434c9 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -13,6 +13,7 @@ module GitHub.Endpoints.Organizations.Members ( isMemberOf, isMemberOf', isMemberOfR, + orgInvitationsR, module GitHub.Data, ) where @@ -78,4 +79,10 @@ isMemberOf = isMemberOf' Nothing -- See isMemberOfR :: Name User -> Name Organization -> Request k Bool isMemberOfR user org = StatusQuery statusOnlyOk $ - Query [ "orgs", toPathPart org, "members", toPathPart user ] [] \ No newline at end of file + 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"] [] From 9d0cc9122624759d43a87e21e207adf86e1841ab Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:37:10 +0200 Subject: [PATCH 104/309] Update changelog --- CHANGELOG.md | 50 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 36 insertions(+), 14 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d45dcdc8..ac855161 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,27 @@ -Changes for 0.19 -- TBW +## Changes for 0.19 + +- Fix issue event type enumeration + [#301](https://github.com/phadej/github/issues/301) +- Include label info in `IssseEvent` + [#302](https://github.com/phadej/github/issues/302) +- Fix `ShowRepo` example + [#306](https://github.com/phadej/github/pull/306) +- Add "Get archive link" API + [#307](https://github.com/phadej/github/pull/307) +- Make "repo" in PullRequestCommit nullable (repository can be gone) + [#311](https://github.com/phadej/github/pull/311) +- Add read-only emails endpoint + [#313](https://github.com/phadej/github/pull/313) +- Organisation membership API + [#312](https://github.com/phadej/github/pull/312) +- Fix isPullRequestMerged and other boolean responses + [#312](https://github.com/phadej/github/pull/312) +- Add `behind` pull request mergeable state + [#308](https://github.com/phadej/github/pull/308) +- Add list organisation invitations endpoint + +## Changes for 0.18 -Changes for 0.18 - Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) - Endpoints for (un)starring gists. @@ -15,13 +35,15 @@ Changes for 0.18 - Add requested reviewers field to pull request records. [#292](https://github.com/phadej/github/pull/292) -Changes for 0.17.0 +## Changes for 0.17.0 + - Add `Ord Request` instance - Repository contents - Repository starring endpoints - Pull Request review endpoints -Changes for 0.16.0 +## Changes for 0.16.0 + - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies @@ -29,7 +51,7 @@ Changes for 0.16.0 - release endpoints - forkExistingRepo -Changes for 0.15.0 +## Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering @@ -51,7 +73,7 @@ Changes for 0.15.0 See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) -Changes for 0.14.1 +## Changes for 0.14.1 - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` @@ -59,7 +81,7 @@ Changes for 0.14.1 `RepoPublicity` - Don't require network access for search tests -Changes for 0.14.0 +## Changes for 0.14.0 Large API changes: @@ -70,7 +92,7 @@ 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: +## Changes for 0.5.0: * OAuth. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. @@ -78,7 +100,7 @@ Changes for 0.5.0: * Relax the attoparsec version requirements. * The above by [John Wiegley](https://github.com/jwiegley). -Changes for 0.4.1: +## Changes for 0.4.1: * Stop using the uri package. * Use aeson version 0.6.1.0. @@ -86,11 +108,11 @@ Changes for 0.4.1: * 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. -Changes for 0.3.0: +## Changes for 0.3.0: * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. @@ -100,11 +122,11 @@ 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: * Expand the unordered-containers dependency to anything in 0.1.x . -Changes for 0.2.0: +## Changes for 0.2.0: * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names From df2e36a5301b4f3209898024a6770165c82c3b20 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 16:51:05 +0200 Subject: [PATCH 105/309] Rearrange build-depends, disallow mtl-2.2 (no Except module) --- github.cabal | 66 ++++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/github.cabal b/github.cabal index a4745206..eeafcf89 100644 --- a/github.cabal +++ b/github.cabal @@ -131,38 +131,42 @@ Library GitHub.Endpoints.Users.Followers GitHub.Request - -- Packages needed in order to build this package. - build-depends: base >=4.7 && <4.11, - aeson >=0.7.0.6 && <1.3, - base-compat >=0.9.1 && <0.10, - base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.10, - binary-orphans >=0.1.0.0 && <0.2, - byteable >=0.1.1 && <0.2, - 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.6, - http-client-tls >=0.2.2 && <0.4, - http-link-header >=1.0.1 && <1.1, - http-types >=0.12 && <0.13, - 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.10, - 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.13, - vector-instances >=3.3.0.1 && <3.5, + -- Packages bundles with GHC, mtl and text are also here + build-depends: + base >=4.7 && <4.11, + bytestring >=0.10.4.0 && <0.11, + containers >=0.5.5.1 && <0.6, + deepseq >=1.3.0.2 && <1.5, + mtl (>=2.1.3.1 && <2.2) || (>=2.2.1 && <2.3), + text >=1.2.0.6 && <1.3, + time >=1.4 && <1.10, + transformers >=0.3.0.0 && <0.6 - tls >=1.3.5 + -- other packages + build-depends: + aeson >=0.7.0.6 && <1.3, + base-compat >=0.9.1 && <0.10, + base16-bytestring >=0.1.1.6 && <0.2, + binary >=0.7.1.0 && <0.10, + binary-orphans >=0.1.0.0 && <0.2, + byteable >=0.1.1 && <0.2, + cryptohash >=0.11 && <0.12, + deepseq-generics >=0.1.1.2 && <0.3, + exceptions >=0.8.0.2 && <0.9, + hashable >=1.2.3.3 && <1.3, + http-client >=0.4.8.1 && <0.6, + http-client-tls >=0.2.2 && <0.4, + http-link-header >=1.0.1 && <1.1, + http-types >=0.12.1 && <0.13, + iso8601-time >=0.1.4 && <0.2, + network-uri >=2.6.0.3 && <2.7, + semigroups >=0.16.2.2 && <0.19, + transformers-compat >=0.4.0.3 && <0.6, + unordered-containers >=0.2 && <0.3, + vector >=0.10.12.3 && <0.13, + vector-instances >=3.3.0.1 && <3.5, + + tls >=1.3.5 if flag(aeson-compat) build-depends: aeson-compat >=0.3.0.0 && <0.4 From 8d0f54def8a9ba1720c79ab0b7adce8273e02244 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 12 Mar 2018 20:42:17 +0200 Subject: [PATCH 106/309] Support GHC-8.4.1 --- github.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/github.cabal b/github.cabal index eeafcf89..4a31324f 100644 --- a/github.cabal +++ b/github.cabal @@ -25,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -133,7 +133,7 @@ Library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.11, + base >=4.7 && <4.12, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, deepseq >=1.3.0.2 && <1.5, @@ -144,7 +144,7 @@ Library -- other packages build-depends: - aeson >=0.7.0.6 && <1.3, + aeson >=0.7.0.6 && <1.4, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, @@ -152,7 +152,7 @@ Library byteable >=0.1.1 && <0.2, cryptohash >=0.11 && <0.12, deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.9, + exceptions >=0.8.0.2 && <0.11, hashable >=1.2.3.3 && <1.3, http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, @@ -161,7 +161,7 @@ Library iso8601-time >=0.1.4 && <0.2, network-uri >=2.6.0.3 && <2.7, semigroups >=0.16.2.2 && <0.19, - transformers-compat >=0.4.0.3 && <0.6, + transformers-compat >=0.4.0.3 && <0.7, unordered-containers >=0.2 && <0.3, vector >=0.10.12.3 && <0.13, vector-instances >=3.3.0.1 && <3.5, From c8b9ca34dca780a48179c3c84b87643a3a4aec57 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 8 Apr 2018 20:38:15 +0300 Subject: [PATCH 107/309] Allow base-compat-0.10 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 4a31324f..e9b632eb 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,6 @@ name: github version: 0.19 +x-revision: 2 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -145,7 +146,7 @@ Library -- other packages build-depends: aeson >=0.7.0.6 && <1.4, - base-compat >=0.9.1 && <0.10, + base-compat >=0.9.1 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, binary-orphans >=0.1.0.0 && <0.2, From 8dfa3d7d930c774fc119b9bc16d60076ba843de8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 12 Jun 2018 13:36:51 +0300 Subject: [PATCH 108/309] Allow aeson-1.4 --- .travis.yml | 19 +++++++++++-------- github.cabal | 6 +++--- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/.travis.yml b/.travis.yml index b277ed12..2a6d5ea8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,18 +32,21 @@ before_cache: matrix: include: - - compiler: "ghc-7.8.4" + - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} - - compiler: "ghc-7.10.3" + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} + - compiler: "ghc-7.10.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} before_install: - HC=${CC} @@ -75,7 +78,7 @@ install: - rm -f cabal.project.freeze - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf "."/.ghc.environment.* "."/dist + - rm -rf .ghc.environment.* "."/dist - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Here starts the actual work to be performed for the package under test; diff --git a/github.cabal b/github.cabal index e9b632eb..29b5dc22 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ name: github version: 0.19 -x-revision: 2 +x-revision: 3 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -26,7 +26,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 cabal-version: >=1.10 extra-source-files: README.md, @@ -145,7 +145,7 @@ Library -- other packages build-depends: - aeson >=0.7.0.6 && <1.4, + aeson >=0.7.0.6 && <1.5, base-compat >=0.9.1 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, From 445f297649e1e887d76d637014bf8df32fd64762 Mon Sep 17 00:00:00 2001 From: Artem Ohanjanyan Date: Mon, 9 Jul 2018 20:09:25 +0300 Subject: [PATCH 109/309] Add webhook installation events --- src/GitHub/Data/Webhooks.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index ea0604e5..9e8d1c4b 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -38,6 +38,8 @@ data RepoWebhookEvent | WebhookDeploymentStatusEvent | WebhookForkEvent | WebhookGollumEvent + | WebhookInstallationEvent + | WebhookInstallationRepositoriesEvent | WebhookIssueCommentEvent | WebhookIssuesEvent | WebhookMemberEvent @@ -110,6 +112,8 @@ instance FromJSON RepoWebhookEvent where parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent parseJSON (String "fork") = pure WebhookForkEvent parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "installation") = pure WebhookInstallationEvent + parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent parseJSON (String "issues") = pure WebhookIssuesEvent parseJSON (String "member") = pure WebhookMemberEvent @@ -134,6 +138,8 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookDeploymentStatusEvent = String "deployment_status" toJSON WebhookForkEvent = String "fork" toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookInstallationEvent = String "installation" + toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" toJSON WebhookIssueCommentEvent = String "issue_comment" toJSON WebhookIssuesEvent = String "issues" toJSON WebhookMemberEvent = String "member" From 3373cbf04188259bb3979210db83b6183db86905 Mon Sep 17 00:00:00 2001 From: Brendan Hay Date: Tue, 24 Jul 2018 10:47:46 +0200 Subject: [PATCH 110/309] Adding basic deployments and deployment statuses support --- github.cabal | 2 + src/GitHub/Data.hs | 2 + src/GitHub/Data/Deployments.hs | 205 ++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Deployments.hs | 68 +++++++ 4 files changed, 277 insertions(+) create mode 100644 src/GitHub/Data/Deployments.hs create mode 100644 src/GitHub/Endpoints/Repos/Deployments.hs diff --git a/github.cabal b/github.cabal index 29b5dc22..1b07f1ee 100644 --- a/github.cabal +++ b/github.cabal @@ -75,6 +75,7 @@ Library GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Deployments GitHub.Data.Email GitHub.Data.Events GitHub.Data.Gists @@ -122,6 +123,7 @@ Library GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Contents GitHub.Endpoints.Repos.DeployKeys + GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 1c935721..b429a99e 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -37,6 +37,7 @@ module GitHub.Data ( 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, @@ -66,6 +67,7 @@ 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 diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs new file mode 100644 index 00000000..8234d998 --- /dev/null +++ b/src/GitHub/Data/Deployments.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE LambdaCase #-} + +module GitHub.Data.Deployments + ( DeploymentQueryOption (..) + , renderDeploymentQueryOption + + , Deployment (..) + , CreateDeployment (..) + + , DeploymentStatus (..) + , DeploymentStatusState (..) + , CreateDeploymentStatus (..) + ) where + +import Control.Arrow (second) + +import Data.ByteString (ByteString) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.Vector (Vector) + +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude + +import qualified Data.Aeson as JSON +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + +data DeploymentQueryOption + = DeploymentQuerySha !Text + | DeploymentQueryRef !Text + | DeploymentQueryTask !Text + | DeploymentQueryEnvironment !Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DeploymentQueryOption where rnf = genericRnf +instance Binary DeploymentQueryOption + +renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) +renderDeploymentQueryOption = + second Text.encodeUtf8 . \case + DeploymentQuerySha sha -> ("sha", sha) + DeploymentQueryRef ref -> ("ref", ref) + DeploymentQueryTask task -> ("task", task) + DeploymentQueryEnvironment env -> ("environment", env) + +data Deployment a = Deployment + { deploymentUrl :: !URL + , deploymentId :: !(Id (Deployment a)) + , deploymentSha :: !(Name (Deployment a)) + , deploymentRef :: !Text + , deploymentTask :: !Text + , deploymentPayload :: !(Maybe a) + , deploymentEnvironment :: !Text + , deploymentDescription :: !Text + , deploymentCreator :: !SimpleUser + , deploymentCreatedAt :: !UTCTime + , deploymentUpdatedAt :: !UTCTime + , deploymentStatusesUrl :: !URL + , deploymentRepositoryUrl :: !URL + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData a => NFData (Deployment a) where rnf = genericRnf +instance Binary a => Binary (Deployment a) + +instance FromJSON a => FromJSON (Deployment a) where + parseJSON = withObject "GitHub Deployment" $ \o -> + Deployment + <$> o .: "url" + <*> o .: "id" + <*> o .: "sha" + <*> o .: "ref" + <*> o .: "task" + <*> o .:? "payload" + <*> o .: "environment" + <*> o .: "description" + <*> o .: "creator" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "statuses_url" + <*> o .: "repository_url" + +data CreateDeployment a = CreateDeployment + { createDeploymentRef :: !Text + -- ^ Required. The ref to deploy. This can be a branch, tag, or SHA. + , createDeploymentTask :: !(Maybe Text) + -- ^ Specifies a task to execute (e.g., deploy or deploy:migrations). + -- Default: deploy + , createDeploymentAutoMerge :: !(Maybe Bool) + -- ^ Attempts to automatically merge the default branch into the requested + -- ref, if it is behind the default branch. Default: true + , createDeploymentRequiredContexts :: !(Maybe (Vector Text)) + -- ^ The status contexts to verify against commit status checks. If this + -- parameter is omitted, then all unique contexts will be verified before a + -- deployment is created. To bypass checking entirely pass an empty array. + -- Defaults to all unique contexts. + , createDeploymentPayload :: !(Maybe a) + -- ^ JSON payload with extra information about the deployment. Default: "" + , createDeploymentEnvironment :: !(Maybe Text) + -- ^ Name for the target deployment environment (e.g., production, staging, + -- qa). Default: production + , createDeploymentDescription :: !(Maybe Text) + -- ^ Short description of the deployment. Default: "" + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData a => NFData (CreateDeployment a) where rnf = genericRnf +instance Binary a => Binary (CreateDeployment a) + +instance ToJSON a => ToJSON (CreateDeployment a) where + toJSON x = + JSON.object $ catMaybes + [ Just ("ref" .= createDeploymentRef x) + , ("task" .=) <$> createDeploymentTask x + , ("auto_merge" .=) <$> createDeploymentAutoMerge x + , ("required_contexts" .=) <$> createDeploymentRequiredContexts x + , ("payload" .=) <$> createDeploymentPayload x + , ("environment" .=) <$> createDeploymentEnvironment x + , ("description" .=) <$> createDeploymentDescription x + ] + +data DeploymentStatus = DeploymentStatus + { deploymentStatusUrl :: !URL + , deploymentStatusId :: !(Id DeploymentStatus) + , deploymentStatusState :: !DeploymentStatusState + , deploymentStatusCreator :: !SimpleUser + , deploymentStatusDescription :: !Text + , deploymentStatusTargetUrl :: !URL + , deploymentStatusCreatedAt :: !UTCTime + , deploymentStatusUpdatedAt :: !UTCTime + , deploymentStatusDeploymentUrl :: !URL + , deploymentStatusRepositoryUrl :: !URL + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DeploymentStatus where rnf = genericRnf +instance Binary DeploymentStatus + +instance FromJSON DeploymentStatus where + parseJSON = withObject "GitHub DeploymentStatus" $ \o -> + DeploymentStatus + <$> o .: "url" + <*> o .: "id" + <*> o .: "state" + <*> o .: "creator" + <*> o .: "description" + <*> o .: "target_url" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "deployment_url" + <*> o .: "repository_url" + +data DeploymentStatusState + = DeploymentStatusError + | DeploymentStatusFailure + | DeploymentStatusPending + | DeploymentStatusSuccess + | DeploymentStatusInactive + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DeploymentStatusState where rnf = genericRnf +instance Binary DeploymentStatusState + +instance ToJSON DeploymentStatusState where + toJSON = \case + DeploymentStatusError -> "error" + DeploymentStatusFailure -> "failure" + DeploymentStatusPending -> "pending" + DeploymentStatusSuccess -> "success" + DeploymentStatusInactive -> "inactive" + +instance FromJSON DeploymentStatusState where + parseJSON = withText "GitHub DeploymentStatusState" $ \case + "error" -> pure DeploymentStatusError + "failure" -> pure DeploymentStatusFailure + "pending" -> pure DeploymentStatusPending + "success" -> pure DeploymentStatusSuccess + "inactive" -> pure DeploymentStatusInactive + x -> fail $ "Unknown deployment status: " ++ Text.unpack x + +data CreateDeploymentStatus = CreateDeploymentStatus + { createDeploymentStatusState :: !DeploymentStatusState + -- ^ Required. The state of the status. Can be one of error, failure, + -- pending, or success. + , createDeploymentStatusTargetUrl :: !(Maybe Text) -- TODO: should this be URL? + -- ^ The target URL to associate with this status. This URL should contain + -- output to keep the user updated while the task is running or serve as + -- historical information for what happened in the deployment. Default: "" + , createDeploymentStatusDescription :: !(Maybe Text) + -- ^ A short description of the status. Maximum length of 140 characters. + -- Default: "" + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateDeploymentStatus where rnf = genericRnf +instance Binary CreateDeploymentStatus + +instance ToJSON CreateDeploymentStatus where + toJSON x = + JSON.object $ catMaybes + [ Just ("state" .= createDeploymentStatusState x) + , ("target_url" .=) <$> createDeploymentStatusTargetUrl x + , ("description" .=) <$> createDeploymentStatusDescription x + ] diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs new file mode 100644 index 00000000..21c29587 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE LambdaCase #-} + +-- | The deployments API, as described at +module GitHub.Endpoints.Repos.Deployments + ( deploymentsWithOptionsForR + , createDeploymentR + + , deploymentStatusesForR + , createDeploymentStatusR + + , module GitHub.Data + ) where + +import Control.Arrow (second) + +import Data.Vector (Vector) + +import GitHub.Data +import GitHub.Internal.Prelude + +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 + +createDeploymentR + :: ( ToJSON a + , FromJSON a + ) + => Name Owner + -> Name Repo + -> CreateDeployment a + -> Request 'RW (Deployment a) +createDeploymentR owner repo = + command Post (deployPaths owner repo) . encode + +deploymentStatusesForR + :: Name Owner + -> Name Repo + -> Id (Deployment a) + -> FetchCount + -> Request 'RA (Vector DeploymentStatus) +deploymentStatusesForR owner repo deploy = + pagedQuery (statusesPaths owner repo deploy) [] + +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"] From 6fc6dc7acc8a666a1b3511567bdadc0fef921ff2 Mon Sep 17 00:00:00 2001 From: Mark Santolucito Date: Thu, 22 Feb 2018 12:39:12 -0500 Subject: [PATCH 111/309] Add support for RateLimit API call --- github.cabal | 3 +++ src/GitHub.hs | 6 +++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/RateLimit.hs | 40 +++++++++++++++++++++++++++++++ src/GitHub/Endpoints/RateLimit.hs | 34 ++++++++++++++++++++++++++ 5 files changed, 85 insertions(+) create mode 100644 src/GitHub/Data/RateLimit.hs create mode 100644 src/GitHub/Endpoints/RateLimit.hs diff --git a/github.cabal b/github.cabal index 1b07f1ee..d226410d 100644 --- a/github.cabal +++ b/github.cabal @@ -65,6 +65,7 @@ Library GADTs KindSignatures StandaloneDeriving + RecordWildCards exposed-modules: GitHub GitHub.Internal.Prelude @@ -87,6 +88,7 @@ Library GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests + GitHub.Data.RateLimit GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request @@ -117,6 +119,7 @@ Library GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.Comments + GitHub.Endpoints.RateLimit GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub.hs b/src/GitHub.hs index 8cf6cbdf..054e8c8b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -344,6 +344,11 @@ module GitHub ( createStatusR, statusesForR, statusForR, + + -- ** Rate Limit + -- | See + rateLimit, + rateLimit', -- * Data definitions module GitHub.Data, @@ -372,6 +377,7 @@ import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.Comments +import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index b429a99e..aff42cdc 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -47,6 +47,7 @@ module GitHub.Data ( module GitHub.Data.Milestone, module GitHub.Data.Options, module GitHub.Data.PullRequests, + module GitHub.Data.RateLimit, module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, @@ -79,6 +80,7 @@ import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options import GitHub.Data.PullRequests +import GitHub.Data.RateLimit import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs new file mode 100644 index 00000000..1d253583 --- /dev/null +++ b/src/GitHub/Data/RateLimit.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.RateLimit where + +import GitHub.Internal.Prelude +import Prelude () + + +data RateLimit = RateLimit + { coreLimit :: !Int + , coreRemaining :: !Int + , coreReset :: !Int + , searchLimit :: !Int + , searchRemaining :: !Int + , searchReset :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RateLimit where rnf = genericRnf +instance Binary RateLimit + +instance FromJSON RateLimit where + parseJSON = withObject "RateLimit" $ \o -> do + resources <- o .: "resources" + core <- resources .: "core" + coreLimit <- core .: "limit" + coreRemaining <- core .: "remaining" + coreReset <- core .: "reset" + + search <- resources .: "search" + searchLimit <- search .: "limit" + searchRemaining <- search .: "remaining" + searchReset <- search .: "reset" + + return RateLimit{..} diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs new file mode 100644 index 00000000..c4f47b4d --- /dev/null +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github RateLimit API, as described at +-- . +module GitHub.Endpoints.RateLimit( + rateLimit', + rateLimit, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +import qualified Data.Text.Encoding as TE + +-- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) +-- With authentication. +rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) +rateLimit' auth = executeRequestMaybe auth rateLimitR + +-- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) +-- Without authentication. +-- +-- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +rateLimit :: IO (Either Error RateLimit) +rateLimit = rateLimit' Nothing + +rateLimitR :: Request k RateLimit +rateLimitR = query ["rate_limit"] [] From 855cefecd2e4a07129586a617c7bb3717ba8cf50 Mon Sep 17 00:00:00 2001 From: Mark Santolucito Date: Thu, 22 Feb 2018 12:45:16 -0500 Subject: [PATCH 112/309] add RateLimit sample usage --- samples/RateLimit.hs | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 samples/RateLimit.hs diff --git a/samples/RateLimit.hs b/samples/RateLimit.hs new file mode 100644 index 00000000..c0cabd5f --- /dev/null +++ b/samples/RateLimit.hs @@ -0,0 +1,8 @@ +module RateLimit where + +import qualified Github.RateLimit as Github + +main = do + x <- Github.rateLimit + print x + From dc27d8151dfc510a3f1ab3eeeca4c18b4fab94ab Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 20:33:17 +0300 Subject: [PATCH 113/309] Add deployments to GitHub --- src/GitHub.hs | 19 ++++++++++++++++--- src/GitHub/Endpoints/Repos/Deployments.hs | 10 ++++++++-- 2 files changed, 24 insertions(+), 5 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 054e8c8b..fbcf4e8a 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -259,7 +259,7 @@ module GitHub ( -- -- * Create a commit comment -- * Update a commit comment - -- * Delete a commit comment + -- * Delete a commit comment commentsForR, commitCommentsForR, commitCommentForR, @@ -271,6 +271,18 @@ module GitHub ( commitR, diffR, + -- ** Deployments + -- | See + -- + -- Missing endpoints: + -- * Get a single deployment + -- * Update a deployment + -- * Get a single deployment status + deploymentsWithOptionsForR, + createDeploymentR, + deploymentStatusesForR, + createDeploymentStatusR, + -- ** Forks -- | See -- @@ -344,7 +356,7 @@ module GitHub ( createStatusR, statusesForR, statusForR, - + -- ** Rate Limit -- | See rateLimit, @@ -375,13 +387,14 @@ import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests -import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.Comments +import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits +import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs index 21c29587..ed94c16a 100644 --- a/src/GitHub/Endpoints/Repos/Deployments.hs +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - -- | The deployments API, as described at module GitHub.Endpoints.Repos.Deployments ( deploymentsWithOptionsForR @@ -18,6 +16,8 @@ import Data.Vector (Vector) import GitHub.Data import GitHub.Internal.Prelude +-- | List deployments. +-- See deploymentsWithOptionsForR :: FromJSON a => Name Owner @@ -30,6 +30,8 @@ deploymentsWithOptionsForR owner repo limit opts = (map (second Just . renderDeploymentQueryOption) opts) limit +-- | Create a deployment. +-- See createDeploymentR :: ( ToJSON a , FromJSON a @@ -41,6 +43,8 @@ createDeploymentR createDeploymentR owner repo = command Post (deployPaths owner repo) . encode +-- | List deployment statuses. +-- See deploymentStatusesForR :: Name Owner -> Name Repo @@ -50,6 +54,8 @@ deploymentStatusesForR deploymentStatusesForR owner repo deploy = pagedQuery (statusesPaths owner repo deploy) [] +-- | Create a deployment status. +-- See createDeploymentStatusR :: Name Owner -> Name Repo From 6ae6af79193dce8b244f6713fc7baf947fd4d809 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 20:48:52 +0300 Subject: [PATCH 114/309] Some cleanups --- CHANGELOG.md | 9 +++++++ CONTRIBUTING.md | 42 ++++++++++++++++------------- src/GitHub.hs | 3 +-- src/GitHub/Data/RateLimit.hs | 45 ++++++++++++++++--------------- src/GitHub/Endpoints/RateLimit.hs | 11 ++++---- 5 files changed, 62 insertions(+), 48 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ac855161..eb5d788d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## Changes for 0.19.1 + +- Add ratelimit endpoint + [#315](https://github.com/phadej/github/pull/315/) +- Add some deployment endoints + [#330](https://github.com/phadej/github/pull/330/) +- Add webhook installation events + [#329](https://github.com/phadej/github/pull/330/) + ## Changes for 0.19 - Fix issue event type enumeration diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index c18ad2b4..8bb941ef 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,26 +1,30 @@ 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. +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/src/GitHub.hs b/src/GitHub.hs index fbcf4e8a..d507e980 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -359,8 +359,7 @@ module GitHub ( -- ** Rate Limit -- | See - rateLimit, - rateLimit', + rateLimitR, -- * Data definitions module GitHub.Data, diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 1d253583..3fbd6211 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -10,14 +8,26 @@ module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () +data Limits = Limits + { limitsMax :: !Int + , limitsRemaining :: !Int + , limitsReset :: !Int -- TODO: change to proper type + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Limits where rnf = genericRnf +instance Binary Limits + +instance FromJSON Limits where + parseJSON = withObject "Limits" $ \obj -> Limits + <$> obj .: "limit" + <*> obj .: "remaining" + <*> obj .: "reset" data RateLimit = RateLimit - { coreLimit :: !Int - , coreRemaining :: !Int - , coreReset :: !Int - , searchLimit :: !Int - , searchRemaining :: !Int - , searchReset :: !Int + { rateLimitCore :: Limits + , rateLimitSearch :: Limits + , rateLimitGraphQL :: Limits } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -25,16 +35,9 @@ instance NFData RateLimit where rnf = genericRnf instance Binary RateLimit instance FromJSON RateLimit where - parseJSON = withObject "RateLimit" $ \o -> do - resources <- o .: "resources" - core <- resources .: "core" - coreLimit <- core .: "limit" - coreRemaining <- core .: "remaining" - coreReset <- core .: "reset" - - search <- resources .: "search" - searchLimit <- search .: "limit" - searchRemaining <- search .: "remaining" - searchReset <- search .: "reset" - - return RateLimit{..} + parseJSON = withObject "RateLimit" $ \obj -> do + resources <- obj .: "resources" + RateLimit + <$> resources .: "core" + <*> resources .: "search" + <*> resources .: "graphql" diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs index c4f47b4d..d357fbe8 100644 --- a/src/GitHub/Endpoints/RateLimit.hs +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -5,9 +5,10 @@ -- -- The Github RateLimit API, as described at -- . -module GitHub.Endpoints.RateLimit( - rateLimit', +module GitHub.Endpoints.RateLimit ( + rateLimitR, rateLimit, + rateLimit', module GitHub.Data, ) where @@ -16,8 +17,6 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () -import qualified Data.Text.Encoding as TE - -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- With authentication. rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) @@ -25,10 +24,10 @@ rateLimit' auth = executeRequestMaybe auth rateLimitR -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- Without authentication. --- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" rateLimit :: IO (Either Error RateLimit) rateLimit = rateLimit' Nothing +-- | Get your current rate limit status. +-- rateLimitR :: Request k RateLimit rateLimitR = query ["rate_limit"] [] From 2fa617cb04d6b4176113a92b161049da4f0bfc32 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 21:10:59 +0300 Subject: [PATCH 115/309] Tighten lower bounds Also add RateLimitSpec --- CHANGELOG.md | 2 +- github.cabal | 63 ++++++++++++--------------- spec/GitHub/OrganizationsSpec.hs | 11 +++-- spec/GitHub/PullRequestReviewsSpec.hs | 12 ++--- spec/GitHub/PullRequestsSpec.hs | 21 ++++----- spec/GitHub/RateLimitSpec.hs | 30 +++++++++++++ spec/GitHub/SearchSpec.hs | 6 +-- spec/GitHub/UsersSpec.hs | 14 +++--- src/GitHub/Data/Request.hs | 1 + src/GitHub/Internal/Prelude.hs | 2 +- src/GitHub/Request.hs | 44 ++----------------- 11 files changed, 96 insertions(+), 110 deletions(-) create mode 100644 spec/GitHub/RateLimitSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index eb5d788d..b19135d0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ -## Changes for 0.19.1 +## Changes for 0.20 - Add ratelimit endpoint [#315](https://github.com/phadej/github/pull/315/) diff --git a/github.cabal b/github.cabal index d226410d..63099e86 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github -version: 0.19 -x-revision: 3 +version: 0.20 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -140,6 +139,7 @@ Library -- Packages bundles with GHC, mtl and text are also here build-depends: base >=4.7 && <4.12, + binary >=0.7.1.0 && <0.10, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, deepseq >=1.3.0.2 && <1.5, @@ -150,34 +150,28 @@ Library -- other packages build-depends: - aeson >=0.7.0.6 && <1.5, - base-compat >=0.9.1 && <0.11, + aeson >=1.4.0.0 && <1.5, + base-compat >=0.10.4 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.10, - binary-orphans >=0.1.0.0 && <0.2, + binary-orphans >=0.1.8.0 && <0.2, byteable >=0.1.1 && <0.2, - cryptohash >=0.11 && <0.12, - deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.11, - hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.6, - http-client-tls >=0.2.2 && <0.4, - http-link-header >=1.0.1 && <1.1, + cryptohash >=0.11.9 && <0.12, + deepseq-generics >=0.2.0.0 && <0.3, + exceptions >=0.10.0 && <0.11, + hashable >=1.2.7.0 && <1.3, + http-client >=0.5.12 && <0.6, + http-client-tls >=0.3.5.3 && <0.4, + http-link-header >=1.0.3.1 && <1.1, http-types >=0.12.1 && <0.13, - iso8601-time >=0.1.4 && <0.2, - network-uri >=2.6.0.3 && <2.7, - semigroups >=0.16.2.2 && <0.19, - transformers-compat >=0.4.0.3 && <0.7, - unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.13, - vector-instances >=3.3.0.1 && <3.5, - - tls >=1.3.5 + iso8601-time >=0.1.5 && <0.2, + network-uri >=2.6.1.0 && <2.7, + semigroups >=0.18.5 && <0.19, + transformers-compat >=0.6 && <0.7, + unordered-containers >=0.2.9.0 && <0.3, + vector >=0.12.0.1 && <0.13, + vector-instances >=3.4 && <3.5, - if flag(aeson-compat) - build-depends: aeson-compat >=0.3.0.0 && <0.4 - else - build-depends: aeson-extra >=0.2.0.0 && <0.3 + tls >=1.4.1 test-suite github-test default-language: Haskell2010 @@ -188,28 +182,25 @@ test-suite github-test other-modules: GitHub.ActivitySpec GitHub.CommitsSpec - GitHub.OrganizationsSpec + GitHub.EventsSpec GitHub.IssuesSpec - GitHub.PullRequestsSpec + GitHub.OrganizationsSpec GitHub.PullRequestReviewsSpec + GitHub.PullRequestsSpec + GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec - GitHub.EventsSpec main-is: Spec.hs ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover + build-tool-depends: hspec-discover:hspec-discover >=2.5.6 && <2.6 build-depends: base, base-compat, + aeson, bytestring, github, vector, unordered-containers, file-embed, - hspec - if flag(aeson-compat) - build-depends: aeson-compat - else - build-depends: aeson-extra - + hspec >= 2.5.6 && <2.6 diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index e53ecb44..171a29ed 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -3,19 +3,18 @@ module GitHub.OrganizationsSpec where import GitHub.Auth (Auth (..)) -import GitHub.Data (SimpleOrganization (..), - SimpleOwner (..), - SimpleTeam (..)) +import GitHub.Data + (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) import GitHub.Endpoints.Organizations (publicOrganizationsFor') import GitHub.Endpoints.Organizations.Members (membersOf') -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 diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index c04b134b..d79e806f 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -2,16 +2,16 @@ module GitHub.PullRequestReviewsSpec where import qualified GitHub -import GitHub.Data.Id (Id(Id)) +import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +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 diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index fbea7c7a..921ec186 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,20 +3,21 @@ module GitHub.PullRequestsSpec where import qualified GitHub -import GitHub.Data.Id (Id(Id)) +import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.ByteString (ByteString) -import Data.Either.Compat (isRight) -import Data.FileEmbed (embedFile) -import Data.Foldable (for_) -import Data.String (fromString) -import qualified Data.Vector as V -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) +import Data.Aeson (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 diff --git a/spec/GitHub/RateLimitSpec.hs b/spec/GitHub/RateLimitSpec.hs new file mode 100644 index 00000000..ea9673ac --- /dev/null +++ b/spec/GitHub/RateLimitSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.RateLimitSpec where + +import qualified GitHub + +import Prelude () +import Prelude.Compat + +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, 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/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 97e311d4..cb8d919a 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,7 +14,7 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), mkId, IssueState (..)) +import GitHub.Data (Auth (..), Issue (..), IssueState (..), mkId) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 5c578c9c..b0b201c2 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -2,20 +2,20 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isLeft, isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified GitHub -import GitHub.Data (Auth (..), Organization (..), - User (..), fromOwner) -import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', - userInfoFor') +import GitHub.Data + (Auth (..), Organization (..), User (..), fromOwner) +import GitHub.Endpoints.Users + (ownerInfoForR, userInfoCurrent', userInfoFor') import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) import GitHub.Request (executeRequest) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c7d70e84..38df74d8 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -37,6 +37,7 @@ import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method import Network.URI (URI) + ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 49680f00..70ba2395 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -37,7 +37,7 @@ module GitHub.Internal.Prelude ( import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat +import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index e9f9cddd..e723287f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -53,17 +51,13 @@ module GitHub.Request ( import GitHub.Internal.Prelude import Prelude () -#if MIN_VERSION_mtl(2,2,0) -import Control.Monad.Except (MonadError (..)) -#else -import Control.Monad.Error (MonadError (..)) -#endif +import Control.Monad.Error.Class (MonadError (..)) import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Data.Aeson.Compat (eitherDecode) +import Data.Aeson (eitherDecode) import Data.List (find) import Network.HTTP.Client @@ -76,11 +70,6 @@ import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, parseURIReference, relativeTo) -#if !MIN_VERSION_http_client(0,5,0) -import qualified Control.Exception as E -import Network.HTTP.Types (ResponseHeaders) -#endif - import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -96,11 +85,7 @@ import GitHub.Data.Request executeRequest :: Auth -> Request k a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr manager auth req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + executeRequestWithMgr manager auth req lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True @@ -151,11 +136,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do executeRequest' ::Request 'RO a -> IO (Either Error a) executeRequest' req = 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' @@ -267,11 +248,7 @@ makeHttpSimpleRequest auth r = case r of $ req where parseUrl' :: MonadThrow m => Text -> m HTTP.Request -#if MIN_VERSION_http_client(0,4,30) parseUrl' = HTTP.parseRequest . T.unpack -#else - parseUrl' = HTTP.parseUrl . T.unpack -#endif url :: Paths -> Text url paths = baseUrl <> "/" <> T.intercalate "/" paths @@ -393,14 +370,8 @@ performPagedRequest httpLbs' predicate initReq = do setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -#if MIN_VERSION_http_client(0,5,0) setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } -#else -setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } -#endif - -#if MIN_VERSION_http_client(0,5,0) successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () successOrMissing sm _req res | check = pure () @@ -410,13 +381,6 @@ successOrMissing sm _req res HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) where Status sci _ = HTTP.responseStatus res -#else -successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> HTTP.CookieJar -> Maybe E.SomeException -successOrMissing sm s@(Status sci _) hs cookiejar - | check = Nothing - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar - where -#endif check = case sm of Nothing -> 200 <= sci && sci < 300 Just sm' -> sci `elem` map fst sm' From e27ee4c742d4b11aa1233c8a9f701c7aca1646e4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 21:12:07 +0300 Subject: [PATCH 116/309] Regenerate .travis.yml --- .travis.yml | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/.travis.yml b/.travis.yml index 2a6d5ea8..c89b7203 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ # # runghc make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' # -# For more information, see https://github.com/hvr/multi-ghc-travis +# For more information, see https://github.com/haskell-CI/haskell-ci # language: c sudo: false @@ -64,14 +64,18 @@ install: - BENCH=${BENCH---enable-benchmarks} - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - - INSTALLED=${INSTALLED-true} + - UNCONSTRAINED=${UNCONSTRAINED-true} + - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} - GHCHEAD=${GHCHEAD-false} - travis_retry cabal update -v - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - rm -fv cabal.project cabal.project.local - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - "printf 'packages: \".\"\\n' > cabal.project" - - cat cabal.project + - touch cabal.project.local + - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + - cat cabal.project || true + - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi @@ -90,13 +94,13 @@ script: - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: github-*/*.cabal\\n' > cabal.project" - - cat cabal.project + - touch cabal.project.local + - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + - cat cabal.project || true + - cat cabal.project.local || true # this builds all libraries and executables (without tests/benchmarks) - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - # Build with installed constraints for packages in global-db - - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi - # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi @@ -108,5 +112,8 @@ script: - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi + # Build without installed constraints for packages in global-db + - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + # REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] # EOF From ec9380cfdb89bdf9a69af63b694dc1339d72da93 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 22:15:46 +0300 Subject: [PATCH 117/309] Remove aeson-compat flag --- CHANGELOG.md | 8 +++++--- github.cabal | 5 ----- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b19135d0..861783bc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,13 @@ ## Changes for 0.20 - Add ratelimit endpoint - [#315](https://github.com/phadej/github/pull/315/) + [#315](https://github.com/phadej/github/pull/315) - Add some deployment endoints - [#330](https://github.com/phadej/github/pull/330/) + [#330](https://github.com/phadej/github/pull/330) - Add webhook installation events - [#329](https://github.com/phadej/github/pull/330/) + [#329](https://github.com/phadej/github/pull/330) +- Tigthen lower bounds (also remove aeson-compat dep) + [#332](https://github.com/phadej/github/pull/332) ## Changes for 0.19 diff --git a/github.cabal b/github.cabal index 63099e86..9ea59270 100644 --- a/github.cabal +++ b/github.cabal @@ -38,11 +38,6 @@ extra-source-files: fixtures/user-organizations.json, fixtures/user.json -flag aeson-compat - description: Whether to use aeson-compat or aeson-extra - default: True - manual: False - source-repository head type: git location: git://github.com/phadej/github.git From 5ee98e5516461a2875c6abc52f4d296c16674545 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 26 Sep 2018 13:24:51 +0300 Subject: [PATCH 118/309] Support ghc-8.6 --- .travis.yml | 13 ++++++++----- github.cabal | 8 ++++---- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/.travis.yml b/.travis.yml index c89b7203..82f84f1a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,21 +32,24 @@ before_cache: matrix: include: + - compiler: "ghc-8.6.1" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}} - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.3], sources: [hvr-ghc]}} - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} - compiler: "ghc-7.10.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}} - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}} before_install: - HC=${CC} diff --git a/github.cabal b/github.cabal index 9ea59270..9984267c 100644 --- a/github.cabal +++ b/github.cabal @@ -25,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -133,10 +133,10 @@ Library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.12, - binary >=0.7.1.0 && <0.10, + base >=4.7 && <4.13, + binary >=0.7.1.0 && <0.11, bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.6, + containers >=0.5.5.1 && <0.7, deepseq >=1.3.0.2 && <1.5, mtl (>=2.1.3.1 && <2.2) || (>=2.2.1 && <2.3), text >=1.2.0.6 && <1.3, From 2553802cc62a371072cb52f906536b562d20ec5e Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:05:36 +1100 Subject: [PATCH 119/309] Tweaks from stylish haskell --- src/GitHub/Data/Milestone.hs | 10 +++++----- src/GitHub/Endpoints/Issues/Milestones.hs | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 26c861de..85171264 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -5,11 +5,11 @@ -- 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 () +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 diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 9f541112..405a6e6a 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -11,13 +11,14 @@ module GitHub.Endpoints.Issues.Milestones ( milestonesR, milestone, milestoneR, + createMilestone, module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All milestones in the repo. -- From d3eff41f1a69c59dd17efa68a3b35cb2e970c1e1 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:06:48 +1100 Subject: [PATCH 120/309] Add data type for new milestone --- src/GitHub/Data/Milestone.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 85171264..73685c91 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -40,3 +40,26 @@ instance FromJSON Milestone where <*> o .: "url" <*> o .: "created_at" <*> o .: "state" + +data NewMilestone = NewMilestone + { newMilestoneTitle :: !Text + , newMilestoneState :: !Text + , newMilestoneDescription :: !(Maybe Text) + , newMilestoneDueOn :: !(Maybe UTCTime) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewMilestone where rnf = genericRnf +instance Binary NewMilestone + + +instance ToJSON NewMilestone where + toJSON (NewMilestone title state desc due) = object $ filter notNull + [ "title" .= title + , "state" .= state + , "description" .= desc + , "due_on" .= due + ] + where + notNull (_, Null) = False + notNull (_, _) = True From 4200fc7675fd16d79b559984a3b670f3ee7f7033 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:07:23 +1100 Subject: [PATCH 121/309] Add function to post to create milestone --- src/GitHub/Endpoints/Issues/Milestones.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 405a6e6a..174ab933 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -51,3 +51,13 @@ milestone user repo mid = milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] + +createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) +createMilestone auth user repo mst = executeRequest auth $ createMilestoneR user repo mst + +-- | 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 + From b07c1d98f54f15cca48d6bd134d4263dbe79b763 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:21:29 +1100 Subject: [PATCH 122/309] Expose create milestone request --- src/GitHub/Endpoints/Issues/Milestones.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 174ab933..2af6c119 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -12,6 +12,7 @@ module GitHub.Endpoints.Issues.Milestones ( milestone, milestoneR, createMilestone, + createMilestoneR, module GitHub.Data, ) where From 35bb7e2bd7898ac1c3e7e884087bd9c0ac0e5992 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:38:22 +1100 Subject: [PATCH 123/309] Export create milestone functions from Github module --- src/GitHub.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index d507e980..ef11f52f 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -139,11 +139,12 @@ module GitHub ( -- -- Missing endpoints: -- - -- * Create a milestone -- * Update a milestone -- * Delete a milestone milestonesR, milestoneR, + createMilestone, + createMilestoneR, -- * Organizations -- | See From 8871b43a3300c25413c7219cffaaaf26b0d6b7c8 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 17:36:11 +1100 Subject: [PATCH 124/309] Restore stylish haskell changes --- src/GitHub/Data/Milestone.hs | 10 +++++----- src/GitHub/Endpoints/Issues/Milestones.hs | 8 ++++---- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 73685c91..157c0eeb 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -5,11 +5,11 @@ -- 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 () +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 diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 2af6c119..253080c3 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -16,10 +16,10 @@ module GitHub.Endpoints.Issues.Milestones ( module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All milestones in the repo. -- From 64fce2697a57b008d8d1aebf22a6fcb2bfd7fb13 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sat, 27 Oct 2018 14:30:05 +1100 Subject: [PATCH 125/309] Add delete endpoint for milestones --- src/GitHub/Endpoints/Issues/Milestones.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 253080c3..43e57476 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -13,6 +13,8 @@ module GitHub.Endpoints.Issues.Milestones ( milestoneR, createMilestone, createMilestoneR, + deleteMilestone, + deleteMilestoneR, module GitHub.Data, ) where @@ -54,7 +56,7 @@ milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) -createMilestone auth user repo mst = executeRequest auth $ createMilestoneR user repo mst +createMilestone auth user repo mlstn = executeRequest auth $ createMilestoneR user repo mlstn -- | Create a milestone. -- See @@ -62,3 +64,10 @@ createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Miles createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode +deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) +deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid + +deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request 'RW () +deleteMilestoneR user repo mid = + command Delete + ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] mempty From 5f7a10a7c59415d8e8b5d821ba10c24cbf4111ef Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sat, 27 Oct 2018 14:30:38 +1100 Subject: [PATCH 126/309] Expose delete endpoint for milestones --- src/GitHub.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index ef11f52f..53856485 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -140,11 +140,12 @@ module GitHub ( -- Missing endpoints: -- -- * Update a milestone - -- * Delete a milestone milestonesR, milestoneR, createMilestone, createMilestoneR, + deleteMilestone, + deleteMilestoneR, -- * Organizations -- | See From bd574f43a29622f661d40e76fb311c46621604b2 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 01:51:51 +1100 Subject: [PATCH 127/309] Add link to Github API docs for delete endpoint --- src/GitHub/Endpoints/Issues/Milestones.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 43e57476..7ad2cfbf 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -67,6 +67,8 @@ createMilestoneR user repo = deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid +-- | Delete a milestone. +-- See deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request 'RW () deleteMilestoneR user repo mid = command Delete From 250e5d901d8348bcd4971bf49db27048151b693c Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 01:53:35 +1100 Subject: [PATCH 128/309] Add new data structure for updating milestones --- src/GitHub/Data/Milestone.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 157c0eeb..a8db2864 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -63,3 +63,26 @@ instance ToJSON NewMilestone where where notNull (_, Null) = False notNull (_, _) = True + +data UpdateMilestone = UpdateMilestone + { updateMilestoneTitle :: !(Maybe Text) + , updateMilestoneState :: !(Maybe Text) + , updateMilestoneDescription :: !(Maybe Text) + , updateMilestoneDueOn :: !(Maybe UTCTime) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData UpdateMilestone where rnf = genericRnf +instance Binary UpdateMilestone + + +instance ToJSON UpdateMilestone where + toJSON (UpdateMilestone title state desc due) = object $ filter notNull + [ "title" .= title + , "state" .= state + , "description" .= desc + , "due_on" .= due + ] + where + notNull (_, Null) = False + notNull (_, _) = True From 1f65d13686d004736aa605345f4a783d9edf437d Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 02:01:38 +1100 Subject: [PATCH 129/309] Add request function to update a milestone --- src/GitHub.hs | 5 ++--- src/GitHub/Endpoints/Issues/Milestones.hs | 11 +++++++++++ 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 53856485..92fb16c4 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -137,13 +137,12 @@ module GitHub ( -- ** Milestone -- | See -- - -- Missing endpoints: - -- - -- * Update a milestone milestonesR, milestoneR, createMilestone, createMilestoneR, + updateMilestone, + updateMilestoneR, deleteMilestone, deleteMilestoneR, diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 7ad2cfbf..06039dd2 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -13,6 +13,8 @@ module GitHub.Endpoints.Issues.Milestones ( milestoneR, createMilestone, createMilestoneR, + updateMilestone, + updateMilestoneR, deleteMilestone, deleteMilestoneR, module GitHub.Data, @@ -64,6 +66,15 @@ createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Miles createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode +updateMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> IO (Either Error Milestone) +updateMilestone auth user repo mid mlstn = executeRequest auth $ updateMilestoneR user repo mid mlstn + +-- | Update a milestone. +-- See +updateMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> Request 'RW Milestone +updateMilestoneR user repo mid = + command Patch ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid ] . encode + deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid From 9cf8c49a38f2171b030be4914d1c8fd9238d7759 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 02:54:31 +1100 Subject: [PATCH 130/309] Make it possible to choose between ignore/delete milestone due date --- src/GitHub/Data/Milestone.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index a8db2864..2c947795 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -68,7 +68,7 @@ data UpdateMilestone = UpdateMilestone { updateMilestoneTitle :: !(Maybe Text) , updateMilestoneState :: !(Maybe Text) , updateMilestoneDescription :: !(Maybe Text) - , updateMilestoneDueOn :: !(Maybe UTCTime) + , updateMilestoneDueOn :: !(Maybe (Maybe UTCTime)) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From b6d287e244f362768a104ddfe8cfd68c0d9c3b7a Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 03:04:00 +1100 Subject: [PATCH 131/309] Restore update milestone due on to be Maybe UTCTime --- src/GitHub/Data/Milestone.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 2c947795..a8db2864 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -68,7 +68,7 @@ data UpdateMilestone = UpdateMilestone { updateMilestoneTitle :: !(Maybe Text) , updateMilestoneState :: !(Maybe Text) , updateMilestoneDescription :: !(Maybe Text) - , updateMilestoneDueOn :: !(Maybe (Maybe UTCTime)) + , updateMilestoneDueOn :: !(Maybe UTCTime) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From b56dd7616765dc33ef0520704bc8e149e492527d Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 30 Oct 2018 07:57:04 -0700 Subject: [PATCH 132/309] Make fileBlobUrl and fileRawUrl optional; Fix #339. These fields are null for the diff api when a commit removes a submodule. Add test that uses the repository I created to test this issue. Remove two redundant imports due to fix warnings. --- spec/GitHub/CommitsSpec.hs | 7 ++++++- spec/GitHub/RateLimitSpec.hs | 1 - src/GitHub/Data/GitData.hs | 4 ++-- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 046fd36d..3bf5fc53 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -5,7 +5,7 @@ module GitHub.CommitsSpec where import qualified GitHub import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', +import GitHub.Endpoints.Repos.Commits (commitSha, commitsFor', commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) @@ -60,3 +60,8 @@ spec = do it "issue #155" $ withAuth $ \auth -> do d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight + + -- diff that includes a commit where a submodule is removed + it "issue #339" $ withAuth $ \auth -> do + d <- executeRequest auth $ diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" + d `shouldSatisfy` isRight diff --git a/spec/GitHub/RateLimitSpec.hs b/spec/GitHub/RateLimitSpec.hs index ea9673ac..dd649955 100644 --- a/spec/GitHub/RateLimitSpec.hs +++ b/spec/GitHub/RateLimitSpec.hs @@ -7,7 +7,6 @@ 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) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 5df5b953..fc035231 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -184,9 +184,9 @@ instance NFData GitUser where rnf = genericRnf instance Binary GitUser data File = File - { fileBlobUrl :: !URL + { fileBlobUrl :: !(Maybe URL) , fileStatus :: !Text - , fileRawUrl :: !URL + , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int , fileSha :: !Text , fileChanges :: !Int From b4422b019605d6e60e5f4b612413bd0e79fc3a59 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 30 Oct 2018 08:19:38 -0700 Subject: [PATCH 133/309] Use (.:?) for safer deserialization of File. --- src/GitHub/Data/GitData.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index fc035231..edeef245 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -251,9 +251,9 @@ instance FromJSON GitUser where instance FromJSON File where parseJSON = withObject "File" $ \o -> File - <$> o .: "blob_url" + <$> o .:? "blob_url" <*> o .: "status" - <*> o .: "raw_url" + <*> o .:? "raw_url" <*> o .: "additions" <*> o .: "sha" <*> o .: "changes" From 9b9cd9f7820073fc0d6a6fc3bd7bd2d8b6a02720 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 13 Dec 2018 17:45:26 +1100 Subject: [PATCH 134/309] Add initial endpoint to add collaborator --- src/GitHub/Endpoints/Repos/Collaborators.hs | 28 ++++++++++++++++++--- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index d3049d7b..c7a95ab7 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -11,13 +11,15 @@ module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOnR, isCollaboratorOn, isCollaboratorOnR, + addCollaborator, + addCollaboratorR, module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who have collaborated on a repo. -- @@ -60,3 +62,21 @@ isCollaboratorOnR -> Request k Bool isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] + +addCollaborator + :: Auth + -> Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator to add + -> IO (Either Error Invitation) +addCollaborator auth owner repo coll = + executeRequest auth $ addCollaboratorR owner repo coll + +addCollaboratorR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator to add + -> Request 'RW Invitation +addCollaboratorR owner repo coll = + command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty +-- /repos/:owner/:repo/collaborators/:username From 9f229669107c0431cd8b48218d5b0aa5a30b2d59 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Fri, 14 Dec 2018 10:46:31 +1100 Subject: [PATCH 135/309] Ignore output of repository invitation --- src/GitHub/Endpoints/Repos/Collaborators.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index c7a95ab7..9961512a 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -68,7 +68,7 @@ addCollaborator -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> IO (Either Error Invitation) + -> IO (Either Error ()) addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll @@ -76,7 +76,7 @@ addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> Request 'RW Invitation + -> Request 'RW () addCollaboratorR owner repo coll = - command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty + command Put' ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty -- /repos/:owner/:repo/collaborators/:username From e76e7a34e9f5bfe42e9e38f118ea710754b6cc84 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Fri, 14 Dec 2018 10:58:30 +1100 Subject: [PATCH 136/309] Add link to API description; expose addCollaboratorR --- src/GitHub.hs | 1 + src/GitHub/Endpoints/Repos/Collaborators.hs | 11 ++++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index ef11f52f..7a5cba55 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -252,6 +252,7 @@ module GitHub ( -- | See collaboratorsOnR, isCollaboratorOnR, + addCollaboratorR, -- ** Comments -- | See diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 9961512a..a672187b 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -16,10 +16,10 @@ module GitHub.Endpoints.Repos.Collaborators ( module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who have collaborated on a repo. -- @@ -72,6 +72,8 @@ addCollaborator addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll +-- | Invite a user as a collaborator. +-- See addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name @@ -79,4 +81,3 @@ addCollaboratorR -> Request 'RW () addCollaboratorR owner repo coll = command Put' ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty --- /repos/:owner/:repo/collaborators/:username From a9a5e8524f9a25d19e24fe7d236a72c085e05b83 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 9 Jan 2019 09:52:23 +0200 Subject: [PATCH 137/309] Allow http-client-0.6; bump hspec versions --- github.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/github.cabal b/github.cabal index 9984267c..5d0ad70c 100644 --- a/github.cabal +++ b/github.cabal @@ -154,7 +154,7 @@ Library deepseq-generics >=0.2.0.0 && <0.3, exceptions >=0.10.0 && <0.11, hashable >=1.2.7.0 && <1.3, - http-client >=0.5.12 && <0.6, + http-client >=0.5.12 && <0.7, http-client-tls >=0.3.5.3 && <0.4, http-link-header >=1.0.3.1 && <1.1, http-types >=0.12.1 && <0.13, @@ -189,7 +189,7 @@ test-suite github-test GitHub.UsersSpec main-is: Spec.hs ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.5.6 && <2.6 + build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.7 build-depends: base, base-compat, aeson, @@ -198,4 +198,4 @@ test-suite github-test vector, unordered-containers, file-embed, - hspec >= 2.5.6 && <2.6 + hspec >= 2.6.1 && <2.7 From 738e08a100bd10e2a6058d7cd3f98f7e6f56965e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 9 Jan 2019 10:09:42 +0200 Subject: [PATCH 138/309] Use cryptohash-sha1 --- CHANGELOG.md | 6 ++++++ github.cabal | 3 +-- src/GitHub/Data/Webhooks/Validate.hs | 12 +++++------- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 861783bc..c5b23633 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## Changes for next + +- Allow http-client-0.6 + +- Change to use `cryptohash-sha1` (before `cryptohash`) + ## Changes for 0.20 - Add ratelimit endpoint diff --git a/github.cabal b/github.cabal index 5d0ad70c..d539d4bb 100644 --- a/github.cabal +++ b/github.cabal @@ -149,8 +149,7 @@ Library base-compat >=0.10.4 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary-orphans >=0.1.8.0 && <0.2, - byteable >=0.1.1 && <0.2, - cryptohash >=0.11.9 && <0.12, + cryptohash-sha1 >=0.11.100.1 && <0.12, deepseq-generics >=0.2.0.0 && <0.3, exceptions >=0.10.0 && <0.11, hashable >=1.2.7.0 && <1.3, diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 00884a5d..a90d4e23 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -12,9 +12,8 @@ module GitHub.Data.Webhooks.Validate ( import GitHub.Internal.Prelude import Prelude () -import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) -import Data.Byteable (constEqBytes, toBytes) -import Data.ByteString (ByteString) +import Crypto.Hash.SHA1 (hmac) +import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE @@ -30,10 +29,9 @@ isValidPayload -- including the 'sha1=...' prefix -> ByteString -- ^ the body -> Bool -isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS +isValidPayload secret shaOpt payload = maybe False (sign ==) shaOptBS where shaOptBS = TE.encodeUtf8 <$> shaOpt - hexDigest = Hex.encode . toBytes . hmacGetDigest - - hm = hmac (TE.encodeUtf8 secret) payload :: HMAC SHA1 + hexDigest = Hex.encode + hm = hmac (TE.encodeUtf8 secret) payload sign = "sha1=" <> hexDigest hm From d79ceece8e7e3b7d89371550f718e8d97dbdea00 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Wed, 16 Jan 2019 05:00:50 +0700 Subject: [PATCH 139/309] Add organizationsR to request user organizations --- src/GitHub.hs | 1 + src/GitHub/Endpoints/Organizations.hs | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index ef11f52f..7e3a293a 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -156,6 +156,7 @@ module GitHub ( -- * Edit an organization publicOrganizationsForR, publicOrganizationR, + organizationsR, -- ** Members -- | See -- diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 8bbc9efe..ada7052b 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -11,6 +11,7 @@ module GitHub.Endpoints.Organizations ( publicOrganization, publicOrganization', publicOrganizationR, + organizationsR, module GitHub.Data, ) where @@ -32,7 +33,12 @@ publicOrganizationsFor' auth org = publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor = publicOrganizationsFor' Nothing --- | List user organizations. +-- | List all user organizations. +-- See +organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) +organizationsR = pagedQuery ["user", "orgs"] [] + +-- | List public user organizations. -- See publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] From d6f4ea6813b595cc553bccb1c19eab34955a831e Mon Sep 17 00:00:00 2001 From: Alex Mason Date: Tue, 5 Feb 2019 08:37:50 +1100 Subject: [PATCH 140/309] Allow multiple assignees in NewIssue and EditIssue (#336) * Replace single assignee fields with vectors * Remove null fields NewIssue * Add missing notNull function * Make assignees just a Vector in NewIssue --- src/GitHub/Data/Issues.hs | 17 ++++++++++------- src/GitHub/Endpoints/Issues.hs | 2 +- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index cb3981fb..82c0324d 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -13,7 +13,7 @@ import GitHub.Data.Options (IssueState) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude -import Prelude () +import Prelude () data Issue = Issue { issueClosedAt :: !(Maybe UTCTime) @@ -43,7 +43,7 @@ instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: !Text , newIssueBody :: !(Maybe Text) - , newIssueAssignee :: !(Maybe Text) + , newIssueAssignees :: !(Vector (Name User)) , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } @@ -55,7 +55,7 @@ instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) - , editIssueAssignee :: !(Maybe (Name User)) + , editIssueAssignees :: !(Maybe (Vector (Name User))) , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) @@ -203,19 +203,22 @@ instance FromJSON Issue where <*> o .:? "milestone" instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = object + toJSON (NewIssue t b a m ls) = object $ filter notNull [ "title" .= t , "body" .= b - , "assignee" .= a + , "assignees" .= a , "milestone" .= m , "labels" .= ls ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON EditIssue where - toJSON (EditIssue t b a s m ls) = object $ filter notNull $ + toJSON (EditIssue t b a s m ls) = object $ filter notNull [ "title" .= t , "body" .= b - , "assignee" .= a + , "assignees" .= a , "state" .= s , "milestone" .= m , "labels" .= ls diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 431e1c3e..7b2c5c43 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -85,7 +85,7 @@ issuesForRepoR user reqRepoName opts = -- Creating new issues. newIssue :: Text -> NewIssue -newIssue title = NewIssue title Nothing Nothing Nothing Nothing +newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create a new issue. From fbfcdd61c83837e354d108bfdae4082677a65ba0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 9 Feb 2019 20:02:54 +0200 Subject: [PATCH 141/309] Fix #334: Introduce IssueNumber newtype --- CHANGELOG.md | 5 +- cabal.project | 3 + github.cabal | 159 +++++++++--------- spec/GitHub/IssuesSpec.hs | 15 +- spec/GitHub/PullRequestsSpec.hs | 3 +- spec/GitHub/SearchSpec.hs | 7 +- src/GitHub/Data.hs | 2 + src/GitHub/Data/Definitions.hs | 22 +++ src/GitHub/Data/Issues.hs | 2 +- src/GitHub/Data/Request.hs | 5 +- src/GitHub/Endpoints/Issues/Comments.hs | 10 +- src/GitHub/Endpoints/PullRequests.hs | 8 +- src/GitHub/Endpoints/PullRequests/Comments.hs | 4 +- 13 files changed, 145 insertions(+), 100 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c5b23633..d73013a0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,9 @@ ## Changes for next -- Allow http-client-0.6 +## Changes for 0.21 -- Change to use `cryptohash-sha1` (before `cryptohash`) +- Allow `http-client-0.6` +- Change to use `cryptohash-sha1` (`cryptohash` was used before) ## Changes for 0.20 diff --git a/cabal.project b/cabal.project index 7625ac15..cf67e0cf 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,6 @@ packages: "." samples + +optimization: False +tests: True diff --git a/github.cabal b/github.cabal index d539d4bb..5d46680d 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,8 @@ -name: github -version: 0.20 -synopsis: Access to the GitHub API, v3. +cabal-version: >=1.10 +name: github +version: 0.21 +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 @@ -17,52 +19,56 @@ description: > print possibleUser . For more of an overview please see the README: -license: BSD3 -license-file: LICENSE -author: Mike Burns, John Wiegley, Oleg Grenrus -maintainer: Oleg Grenrus -homepage: https://github.com/phadej/github -copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus -category: Network -build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 -cabal-version: >=1.10 + +license: BSD3 +license-file: LICENSE +author: Mike Burns, John Wiegley, Oleg Grenrus +maintainer: Oleg Grenrus +homepage: https://github.com/phadej/github +build-type: Simple +copyright: + Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus + +tested-with: + ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.3 + extra-source-files: - README.md, - CHANGELOG.md, - fixtures/issue-search.json, - fixtures/list-teams.json, - fixtures/members-list.json, - fixtures/pull-request-opened.json, - fixtures/pull-request-review-requested.json, - fixtures/user-organizations.json, + README.md + CHANGELOG.md + fixtures/issue-search.json + fixtures/list-teams.json + fixtures/members-list.json + fixtures/pull-request-opened.json + fixtures/pull-request-review-requested.json + fixtures/user-organizations.json fixtures/user.json source-repository head - type: git + type: git location: git://github.com/phadej/github.git -Library - default-language: Haskell2010 - ghc-options: -Wall - hs-source-dirs: src +library + default-language: Haskell2010 + ghc-options: -Wall + hs-source-dirs: src default-extensions: DataKinds DeriveDataTypeable DeriveGeneric OverloadedStrings ScopedTypeVariables + other-extensions: CPP FlexibleContexts FlexibleInstances GADTs KindSignatures + RecordWildCards StandaloneDeriving - RecordWildCards + exposed-modules: GitHub - GitHub.Internal.Prelude GitHub.Auth GitHub.Data GitHub.Data.Activities @@ -111,8 +117,8 @@ Library GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests - GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.Comments + GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.RateLimit GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators @@ -129,50 +135,52 @@ Library GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers + GitHub.Internal.Prelude GitHub.Request -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.13, - binary >=0.7.1.0 && <0.11, - bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.7, - deepseq >=1.3.0.2 && <1.5, - mtl (>=2.1.3.1 && <2.2) || (>=2.2.1 && <2.3), - text >=1.2.0.6 && <1.3, - time >=1.4 && <1.10, - transformers >=0.3.0.0 && <0.6 + base >=4.7 && <4.13 + , binary >=0.7.1.0 && <0.11 + , bytestring >=0.10.4.0 && <0.11 + , containers >=0.5.5.1 && <0.7 + , deepseq >=1.3.0.2 && <1.5 + , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 + , text >=1.2.0.6 && <1.3 + , time >=1.4 && <1.10 + , transformers >=0.3.0.0 && <0.6 -- other packages build-depends: - aeson >=1.4.0.0 && <1.5, - base-compat >=0.10.4 && <0.11, - base16-bytestring >=0.1.1.6 && <0.2, - binary-orphans >=0.1.8.0 && <0.2, - cryptohash-sha1 >=0.11.100.1 && <0.12, - deepseq-generics >=0.2.0.0 && <0.3, - exceptions >=0.10.0 && <0.11, - hashable >=1.2.7.0 && <1.3, - http-client >=0.5.12 && <0.7, - http-client-tls >=0.3.5.3 && <0.4, - http-link-header >=1.0.3.1 && <1.1, - http-types >=0.12.1 && <0.13, - iso8601-time >=0.1.5 && <0.2, - network-uri >=2.6.1.0 && <2.7, - semigroups >=0.18.5 && <0.19, - transformers-compat >=0.6 && <0.7, - unordered-containers >=0.2.9.0 && <0.3, - vector >=0.12.0.1 && <0.13, - vector-instances >=3.4 && <3.5, - - tls >=1.4.1 + aeson >=1.4.0.0 && <1.5 + , base-compat >=0.10.4 && <0.11 + , base16-bytestring >=0.1.1.6 && <0.2 + , binary-orphans >=0.1.8.0 && <0.2 + , cryptohash-sha1 >=0.11.100.1 && <0.12 + , deepseq-generics >=0.2.0.0 && <0.3 + , exceptions >=0.10.0 && <0.11 + , hashable >=1.2.7.0 && <1.3 + , http-client >=0.5.12 && <0.7 + , http-client-tls >=0.3.5.3 && <0.4 + , http-link-header >=1.0.3.1 && <1.1 + , http-types >=0.12.1 && <0.13 + , iso8601-time >=0.1.5 && <0.2 + , network-uri >=2.6.1.0 && <2.7 + , semigroups >=0.18.5 && <0.19 + , tls >=1.4.1 + , transformers-compat >=0.6 && <0.7 + , unordered-containers >=0.2.9.0 && <0.3 + , vector >=0.12.0.1 && <0.13 + , vector-instances >=3.4 && <3.5 test-suite github-test - default-language: Haskell2010 - type: exitcode-stdio-1.0 - hs-source-dirs: spec - other-extensions: - TemplateHaskell + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: spec + main-is: Spec.hs + ghc-options: -Wall + build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.8 + other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec GitHub.CommitsSpec @@ -186,15 +194,14 @@ test-suite github-test GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec - main-is: Spec.hs - ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.7 - build-depends: base, - base-compat, - aeson, - bytestring, - github, - vector, - unordered-containers, - file-embed, - hspec >= 2.6.1 && <2.7 + + build-depends: + aeson + , base + , base-compat + , bytestring + , file-embed + , github + , hspec >=2.6.1 && <2.8 + , unordered-containers + , vector diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 9eb41093..cfad56e3 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -10,7 +10,8 @@ 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 Test.Hspec + (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -28,11 +29,17 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll - 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 where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") - , ("haskell", "cabal") ] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 921ec186..cb7a212f 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,7 +3,6 @@ module GitHub.PullRequestsSpec where import qualified GitHub -import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat @@ -55,7 +54,7 @@ spec = do describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (Id 14) + b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (GitHub.IssueNumber 14) b `shouldSatisfy` isRight fromRightS b `shouldBe` True diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index cb8d919a..64f1680a 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -14,7 +14,8 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), IssueState (..), mkId) +import GitHub.Data + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b @@ -40,13 +41,13 @@ 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` StateClosed let issue2 = issues V.! 1 issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 - issueNumber issue2 `shouldBe` 127 + issueNumber issue2 `shouldBe` IssueNumber 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` StateOpen diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index aff42cdc..3f031a07 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -30,6 +30,8 @@ module GitHub.Data ( mkRepoId, fromUserId, fromOrganizationId, + -- * IssueNumber + IssueNumber (..), -- * Module re-exports module GitHub.Auth, module GitHub.Data.Activities, diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index ea7ed2ea..f440c48c 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -237,6 +237,28 @@ type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int +------------------------------------------------------------------------------- +-- IssueNumber +------------------------------------------------------------------------------- + +newtype IssueNumber = IssueNumber Int + deriving (Eq, Ord, Show, Generic, Typeable, Data) + +unIssueNumber :: IssueNumber -> Int +unIssueNumber (IssueNumber i) = i + +instance Hashable IssueNumber +instance Binary IssueNumber + +instance NFData IssueNumber where + rnf (IssueNumber s) = rnf s + +instance FromJSON IssueNumber where + parseJSON = fmap IssueNumber . parseJSON + +instance ToJSON IssueNumber where + toJSON = toJSON . unIssueNumber + ------------------------------------------------------------------------------- -- IssueLabel ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 82c0324d..1775aeec 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -22,7 +22,7 @@ data Issue = Issue , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: !(Vector IssueLabel) - , issueNumber :: !Int + , issueNumber :: !IssueNumber , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 38df74d8..054e9e4d 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -27,7 +27,7 @@ module GitHub.Data.Request ( Count, ) where -import GitHub.Data.Definitions (Count, QueryString) +import GitHub.Data.Definitions (Count, QueryString, IssueNumber, unIssueNumber) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude @@ -53,6 +53,9 @@ instance IsPathPart (Name a) where instance IsPathPart (Id a) where toPathPart = T.pack . show . untagId +instance IsPathPart IssueNumber where + toPathPart = T.pack . show . unIssueNumber + -- | Http method of requests with body. data CommandMethod a where Post :: CommandMethod a diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 2cbd7c5c..7b46fc0b 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -41,19 +41,19 @@ commentR user repo 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 :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 -comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) +comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid FetchAll -- | List comments on an issue. -- See -commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) +commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] @@ -61,14 +61,14 @@ commentsR user repo iid = -- -- > createComment (User (user, password)) user repo issue -- > "some words" -createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> Text +createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> IO (Either Error Comment) createComment auth user repo iss body = executeRequest auth $ createCommentR user repo iss body -- | Create a comment. -- See -createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'RW Comment +createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment createCommentR user repo iss body = command Post parts (encode $ NewComment body) where diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index bfea41c9..3c2a5447 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -159,24 +159,24 @@ 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 -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error Bool) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid -- | Query if a pull request has been merged. -- See -isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool +isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> Request k Bool isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. -mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> IO (Either Error MergeResult) +mergePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> IO (Either Error MergeResult) mergePullRequest auth user repo prid commitMessage = executeRequest auth $ mergePullRequestR user repo prid commitMessage -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult +mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> Request 'RW MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index ccbf0d93..98d5d2c8 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -21,13 +21,13 @@ import Prelude () -- | All the comments on a pull request with the given ID. -- -- > pullRequestComments "thoughtbot" "factory_girl" (Id 256) -pullRequestCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) +pullRequestCommentsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Comment)) pullRequestCommentsIO user repo prid = executeRequest' $ pullRequestCommentsR user repo prid FetchAll -- | List comments on a pull request. -- See -pullRequestCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) +pullRequestCommentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Comment) pullRequestCommentsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] From ee6efdc1b48635e0d3c39a23b4b5dd95cb4a6180 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Feb 2019 19:03:48 +0200 Subject: [PATCH 142/309] Document GADT constructors --- src/GitHub/Data/Request.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 054e9e4d..a6cd2784 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,6 +61,8 @@ data CommandMethod a where Post :: CommandMethod a Patch :: CommandMethod a Put :: CommandMethod a + + -- | Put requests, where we don't care about response's body Put' :: CommandMethod () Delete :: CommandMethod () deriving (Typeable) @@ -146,6 +148,8 @@ data Request (k :: RW) a where SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a + + -- | Redirect query is /some/ query where we expect status 302 response with @Location@ header. RedirectQuery :: SimpleRequest k () -> Request k URI deriving (Typeable) From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 17 Feb 2019 20:22:32 +0200 Subject: [PATCH 143/309] Refactor Request --- github.cabal | 1 + samples/Operational/Operational.hs | 14 +- src/GitHub/Data/PullRequests.hs | 9 - src/GitHub/Data/Request.hs | 200 ++++------- src/GitHub/Endpoints/Activity/Starring.hs | 8 +- src/GitHub/Endpoints/Gists.hs | 4 +- src/GitHub/Endpoints/Organizations/Members.hs | 4 +- src/GitHub/Endpoints/Organizations/Teams.hs | 4 +- src/GitHub/Endpoints/PullRequests.hs | 8 +- src/GitHub/Endpoints/Repos/Collaborators.hs | 8 +- src/GitHub/Endpoints/Repos/Contents.hs | 7 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 10 +- src/GitHub/Request.hs | 332 ++++++++++-------- 13 files changed, 291 insertions(+), 318 deletions(-) diff --git a/github.cabal b/github.cabal index 5d46680d..36b9dd3b 100644 --- a/github.cabal +++ b/github.cabal @@ -167,6 +167,7 @@ library , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , semigroups >=0.18.5 && <0.19 + , tagged , tls >=1.4.1 , transformers-compat >=0.6 && <0.7 , unordered-containers >=0.2.9.0 && <0.3 diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 751cf69d..b84f9ab9 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,28 +1,32 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common import Prelude () -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Control.Monad.Operational +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified GitHub as GH -type GithubMonad a = Program (GH.Request 'GH.RA) 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 mgr auth m = case view m of Return a -> return a - req :>>= k -> do + R req :>>= k -> do b <- ExceptT $ GH.executeRequestWithMgr mgr auth req runMonad mgr auth (k b) -githubRequest :: GH.Request 'GH.RA a -> GithubMonad a -githubRequest = singleton +githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a +githubRequest = singleton . R main :: IO () main = do diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index e40199f5..0c3df02d 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -14,14 +14,12 @@ module GitHub.Data.PullRequests ( PullRequestEventType(..), PullRequestReference(..), MergeResult(..), - statusMerge, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) -import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -319,10 +317,3 @@ data MergeResult | MergeCannotPerform | MergeConflict deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) - -statusMerge :: StatusMap MergeResult -statusMerge = - [ (200, MergeSuccessful) - , (405, MergeCannotPerform) - , (409, MergeConflict) - ] diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index a6cd2784..8fe08907 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -10,17 +10,16 @@ -- module GitHub.Data.Request ( -- * Request - Request (..), - SimpleRequest (..), + Request, + GenRequest (..), -- * Smart constructors query, pagedQuery, command, -- * Auxiliary types RW(..), - StatusMap, - statusOnlyOk, CommandMethod(..), toMethod, FetchCount(..), + MediaType (..), Paths, IsPathPart(..), QueryString, @@ -34,12 +33,10 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method -import Network.URI (URI) ------------------------------------------------------------------------------ --- Auxillary types +-- Path parts ------------------------------------------------------------------------------ type Paths = [Text] @@ -56,41 +53,30 @@ instance IsPathPart (Id a) where 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 - - -- | Put requests, where we don't care about response's body - Put' :: CommandMethod () - Delete :: CommandMethod () - deriving (Typeable) - -deriving instance Eq (CommandMethod a) -deriving instance Ord (CommandMethod a) - -instance Show (CommandMethod a) where - showsPrec _ Post = showString "Post" - showsPrec _ Patch = showString "Patch" - showsPrec _ Put = showString "Put" - showsPrec _ Put' = showString "Put'" - showsPrec _ Delete = showString "Delete" - -instance Hashable (CommandMethod a) where - hashWithSalt salt Post = hashWithSalt salt (0 :: Int) - hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) - hashWithSalt salt Put = hashWithSalt salt (2 :: Int) - hashWithSalt salt Put' = hashWithSalt salt (3 :: Int) - hashWithSalt salt Delete = hashWithSalt salt (4 :: Int) - -toMethod :: CommandMethod a -> Method.Method +data CommandMethod + = Post + | Patch + | Put + | Delete + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +instance Hashable CommandMethod + +toMethod :: CommandMethod -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut -toMethod Put' = Method.methodPut toMethod Delete = Method.methodDelete +------------------------------------------------------------------------------- +-- Fetch count +------------------------------------------------------------------------------- + -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. data FetchCount = FetchAtLeast !Word | FetchAll @@ -115,15 +101,31 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf +------------------------------------------------------------------------------- +-- MediaType +------------------------------------------------------------------------------- + +data MediaType + = 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 + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + ------------------------------------------------------------------------------ --- Github request +-- RW ------------------------------------------------------------------------------ -- | Type used as with @DataKinds@ to tag whether requests need authentication -- or aren't read-only. data RW = RO -- ^ /Read-only/, doesn't necessarily requires authentication - | RA -- ^ /Read autenticated/ + | RA -- ^ /Read authenticated/ | RW -- ^ /Read-write/, requires authentication deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) @@ -138,102 +140,54 @@ 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 :: RW) a where - SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a - StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a - HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a - - -- | Redirect query is /some/ query where we expect status 302 response with @Location@ header. - RedirectQuery :: SimpleRequest k () -> Request k URI +data GenRequest (mt :: MediaType) (rw :: RW) a where + Query :: Paths -> QueryString -> GenRequest mt rw a + PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) + + -- | Command + Command + :: CommandMethod -- ^ command + -> Paths -- ^ path + -> LBS.ByteString -- ^ body + -> GenRequest mt 'RW a deriving (Typeable) -data SimpleRequest (k :: RW) a where - Query :: Paths -> QueryString -> SimpleRequest k a - PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a) - Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a - deriving (Typeable) - -------------------------------------------------------------------------------- --- Status Map -------------------------------------------------------------------------------- - --- TODO: Change to 'Map' ? -type StatusMap a = [(Int, a)] - -statusOnlyOk :: StatusMap Bool -statusOnlyOk = - [ (204, True) - , (404, False) - ] +-- | Most requests ask for @JSON@. +type Request = GenRequest 'MtJSON ------------------------------------------------------------------------------- -- Smart constructors ------------------------------------------------------------------------------- -query :: FromJSON a => Paths -> QueryString -> Request k a -query ps qs = SimpleQuery (Query ps qs) +query :: Paths -> QueryString -> Request mt a +query ps qs = Query ps qs -pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request k (Vector a) -pagedQuery ps qs fc = SimpleQuery (PagedQuery ps qs fc) +pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a) +pagedQuery ps qs fc = PagedQuery ps qs fc -command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a -command m ps body = SimpleQuery (Command m ps body) +command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a +command m ps body = Command m ps body ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- -deriving instance Eq a => Eq (Request k a) -deriving instance Eq a => Eq (SimpleRequest k a) - -deriving instance Ord a => Ord (Request k a) -deriving instance Ord a => Ord (SimpleRequest k a) - -instance Show (SimpleRequest k a) where - showsPrec d r = showParen (d > appPrec) $ case r of - Query ps qs -> showString "Query " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - PagedQuery ps qs l -> showString "PagedQuery " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - . showString " " - . showsPrec (appPrec + 1) l - Command m ps body -> showString "Command " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) body - where - appPrec = 10 :: Int - -instance Show (Request k a) where - showsPrec d r = showParen (d > appPrec) $ case r of - SimpleQuery req -> showString "SimpleQuery " - . showsPrec (appPrec + 1) req - StatusQuery m req -> showString "Status " - . showsPrec (appPrec + 1) (map fst m) -- !!! printing only keys - . showString " " - . showsPrec (appPrec + 1) req - HeaderQuery m req -> showString "Header " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - RedirectQuery req -> showString "Redirect " - . showsPrec (appPrec + 1) req - where - appPrec = 10 :: Int - -instance Hashable (SimpleRequest k a) where +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 @@ -249,18 +203,4 @@ instance Hashable (SimpleRequest k a) where `hashWithSalt` ps `hashWithSalt` body -instance Hashable (Request k a) where - hashWithSalt salt (SimpleQuery req) = - salt `hashWithSalt` (0 :: Int) - `hashWithSalt` req - hashWithSalt salt (StatusQuery sm req) = - salt `hashWithSalt` (1 :: Int) - `hashWithSalt` map fst sm - `hashWithSalt` req - hashWithSalt salt (HeaderQuery h req) = - salt `hashWithSalt` (2 :: Int) - `hashWithSalt` h - `hashWithSalt` req - hashWithSalt salt (RedirectQuery req) = - salt `hashWithSalt` (3 :: Int) - `hashWithSalt` req +-- TODO: Binary diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index d934185b..71558324 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -71,8 +71,8 @@ myStarredAcceptStar auth = -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: FetchCount -> Request 'RA (Vector RepoStarred) -myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] +myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) +myStarredAcceptStarR = PagedQuery ["user", "starred"] [] -- | Star a repo by the authenticated user. starRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) @@ -80,8 +80,8 @@ starRepo auth user repo = executeRequest auth $ starRepoR user repo -- | Star a repo by the authenticated user. -- See -starRepoR :: Name Owner -> Name Repo -> Request 'RW () -starRepoR user repo = command Put' paths mempty +starRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +starRepoR user repo = Command Put paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index cc23b2a9..13c830a3 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -70,8 +70,8 @@ starGist auth gid = executeRequest auth $ starGistR gid -- | Star a gist by the authenticated user. -- See -starGistR :: Name Gist -> Request 'RW () -starGistR gid = command Put' ["gists", toPathPart gid, "star"] mempty +starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty -- | Unstar a gist by the authenticated user. -- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index d5b434c9..db952269 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -77,8 +77,8 @@ isMemberOf = isMemberOf' Nothing -- | Check if a user is a member of an organization. -- -- See -isMemberOfR :: Name User -> Name Organization -> Request k Bool -isMemberOfR user org = StatusQuery statusOnlyOk $ +isMemberOfR :: Name User -> Name Organization -> GenRequest 'MtStatus rw Bool +isMemberOfR user org = Query [ "orgs", toPathPart org, "members", toPathPart user ] [] -- | List pending organization invitations diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 04af873e..586d1f99 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -168,9 +168,9 @@ addOrUpdateTeamRepo' auth tid org repo permission = -- | Add or update a team repository. -- See -addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> Request 'RW () +addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> GenRequest 'MtUnit 'RW () addOrUpdateTeamRepoR tid org repo permission = - command Put' ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) + Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) -- | Retrieve team mebership information for a user. -- With authentication diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 3c2a5447..036ad4d8 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -165,8 +165,8 @@ isPullRequestMerged auth user repo prid = -- | Query if a pull request has been merged. -- See -isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> 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. @@ -176,8 +176,8 @@ mergePullRequest auth user repo prid commitMessage = -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> Request 'RW MergeResult -mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ +mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult +mergePullRequestR user repo prid commitMessage = Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index a672187b..bc441a28 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -59,8 +59,8 @@ isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? - -> Request k Bool -isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ + -> GenRequest 'MtStatus rw Bool +isCollaboratorOnR user repo coll = Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] addCollaborator @@ -78,6 +78,6 @@ addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> Request 'RW () + -> GenRequest 'MtUnit 'RW () addCollaboratorR owner repo coll = - command Put' ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty + Command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index d424b0c3..39c9a408 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -98,14 +98,15 @@ archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe archiveFor' auth user repo path ref = executeRequestMaybe auth $ archiveForR user repo path ref +-- | Get archive link. +-- See archiveForR :: Name Owner -> Name Repo -> ArchiveFormat -- ^ The type of archive to retrieve -> Maybe Text -- ^ Git commit - -> Request k URI -archiveForR user repo format ref = - RedirectQuery $ Query path [] + -> GenRequest 'MtRedirect rw URI +archiveForR user repo format ref = Query path [] where path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index ebb7377d..34619c17 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------ + ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus @@ -83,8 +83,8 @@ testPushRepoWebhook' auth user repo hookId = -- | Test a push hook. -- See -testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -testPushRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +testPushRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) @@ -93,8 +93,8 @@ pingRepoWebhook' auth user repo hookId = -- | Ping a hook. -- See -pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -pingRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +pingRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index e723287f..424b3e11 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,6 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -27,7 +30,8 @@ -- > githubRequest = singleton module GitHub.Request ( -- * Types - Request(..), + Request, + GenRequest (..), CommandMethod(..), toMethod, Paths, @@ -40,10 +44,11 @@ module GitHub.Request ( executeRequestMaybe, unsafeDropAuthRequirements, -- * Helpers + Accept (..), + ParseResponse (..), makeHttpRequest, - makeHttpSimpleRequest, - parseResponse, parseStatus, + StatusMap, getNextUrl, performPagedRequest, ) where @@ -59,6 +64,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Tagged (Tagged (..)) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), @@ -70,6 +76,7 @@ import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, parseURIReference, relativeTo) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -77,12 +84,13 @@ import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP -import GitHub.Auth (Auth (..)) -import GitHub.Data (Error (..)) +import GitHub.Auth (Auth (..)) +import GitHub.Data (Error (..)) +import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request -- | Execute 'Request' in 'IO' -executeRequest :: Auth -> Request k a -> IO (Either Error a) +executeRequest :: ParseResponse mt a => Auth -> GenRequest mt rw a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req @@ -93,9 +101,10 @@ lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr - :: Manager + :: ParseResponse mt a + => Manager -> Auth - -> Request k a + -> GenRequest mt rw a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req @@ -104,44 +113,31 @@ executeRequestWithMgr mgr auth req = runExceptT $ do httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: HTTP.Request -> Request k b -> ExceptT Error IO b - performHttpReq httpReq (SimpleQuery sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (HeaderQuery _ sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (StatusQuery sm _) = do + performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO b + performHttpReq httpReq Query {} = do res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - performHttpReq httpReq (RedirectQuery _) = do - res <- httpLbs' httpReq - parseRedirect (getUri httpReq) res + unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b - performHttpReq' httpReq Query {} = do - res <- httpLbs' httpReq - parseResponse res - performHttpReq' httpReq (PagedQuery _ _ l) = - performPagedRequest httpLbs' predicate httpReq + performHttpReq httpReq (PagedQuery _ _ l) = + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) where predicate v = lessFetchCount (V.length v) l - performHttpReq' httpReq (Command m _ _) = do - res <- httpLbs' httpReq - case m of - Delete -> pure () - Put' -> pure () - _ -> parseResponse res + performHttpReq httpReq (Command _ _ _) = do + res <- httpLbs' httpReq + unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) -- | Like 'executeRequest' but without authentication. -executeRequest' ::Request 'RO a -> IO (Either Error a) +executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings executeRequestWithMgr' manager req -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' - :: Manager - -> Request 'RO a + :: ParseResponse mt a + => Manager + -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ do httpReq <- makeHttpRequest Nothing req @@ -150,40 +146,157 @@ executeRequestWithMgr' mgr req = runExceptT $ do httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: HTTP.Request -> Request 'RO b -> ExceptT Error IO b - performHttpReq httpReq (SimpleQuery sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (HeaderQuery _ sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (StatusQuery sm _) = do + performHttpReq :: forall mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt 'RO b -> ExceptT Error IO b + performHttpReq httpReq Query {} = do res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - performHttpReq httpReq (RedirectQuery _) = do - res <- httpLbs' httpReq - parseRedirect (getUri httpReq) res - - performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b - performHttpReq' httpReq Query {} = do - res <- httpLbs' httpReq - parseResponse res - performHttpReq' httpReq (PagedQuery _ _ l) = - performPagedRequest httpLbs' predicate httpReq + unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + performHttpReq httpReq (PagedQuery _ _ l) = + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) where predicate v = lessFetchCount (V.length v) l -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) +executeRequestMaybe :: ParseResponse mt a => Maybe Auth -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. -unsafeDropAuthRequirements :: Request k' a -> Request k a -unsafeDropAuthRequirements (SimpleQuery (Query ps qs)) = - SimpleQuery (Query ps qs) -unsafeDropAuthRequirements r = +unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a +unsafeDropAuthRequirements (Query ps qs) = Query ps qs +unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r +------------------------------------------------------------------------------- +-- Parse response +------------------------------------------------------------------------------- + +class Accept (mt :: MediaType) where + contentType :: Tagged mt BS.ByteString + contentType = Tagged "application/json" -- default is JSON + + modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request) + modifyRequest = Tagged id + +class Accept mt => ParseResponse (mt :: MediaType) a where + parseResponse :: MonadError Error m => HTTP.Request -> HTTP.Response LBS.ByteString -> Tagged mt (m a) + +------------------------------------------------------------------------------- +-- JSON (+ star) +------------------------------------------------------------------------------- + +-- | Parse API response. +-- +-- @ +-- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseResponseJSON :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a +parseResponseJSON res = case eitherDecode (responseBody res) of + Right x -> return x + Left err -> throwError . ParseError . T.pack $ err + +instance Accept 'MtJSON where + contentType = Tagged "application/vnd.github.v3+json" + +instance FromJSON a => ParseResponse 'MtJSON a where + parseResponse _ res = Tagged (parseResponseJSON res) + +instance Accept 'MtStar where + contentType = Tagged "application/vnd.github.v3.star+json" + +instance FromJSON a => ParseResponse 'MtStar a where + parseResponse _ res = Tagged (parseResponseJSON res) + +------------------------------------------------------------------------------- +-- Raw / Diff / Patch / Sha +------------------------------------------------------------------------------- + +instance Accept 'MtRaw where contentType = Tagged "application/vnd.github.v3.raw" +instance Accept 'MtDiff where contentType = Tagged "application/vnd.github.v3.diff" +instance Accept 'MtPatch where contentType = Tagged "application/vnd.github.v3.patch" +instance Accept 'MtSha where contentType = Tagged "application/vnd.github.v3.sha" + +instance a ~ LBS.ByteString => ParseResponse 'MtRaw a where parseResponse _ = Tagged . return . responseBody +instance a ~ LBS.ByteString => ParseResponse 'MtDiff a where parseResponse _ = Tagged . return . responseBody +instance a ~ LBS.ByteString => ParseResponse 'MtPatch a where parseResponse _ = Tagged . return . responseBody +instance a ~ LBS.ByteString => ParseResponse 'MtSha a where parseResponse _ = Tagged . return . responseBody + +------------------------------------------------------------------------------- +-- Redirect +------------------------------------------------------------------------------- + +instance Accept 'MtRedirect where + modifyRequest = Tagged $ \req -> + setRequestIgnoreStatus $ req { redirectCount = 0 } + +instance b ~ URI => ParseResponse 'MtRedirect b where + parseResponse req = Tagged . parseRedirect (getUri req) + +-- | Helper for handling of 'RequestRedirect'. +-- +-- @ +-- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI +parseRedirect originalUri rsp = do + let status = responseStatus rsp + when (statusCode status /= 302) $ + throwError $ ParseError $ "invalid status: " <> T.pack (show status) + loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp + case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of + Nothing -> throwError $ ParseError $ + "location header does not contain a URI: " <> T.pack (show loc) + Just uri -> return $ uri `relativeTo` originalUri + where + noLocation = throwError $ ParseError "no location header in response" + +------------------------------------------------------------------------------- +-- 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 +------------------------------------------------------------------------------- + +instance Accept 'MtUnit +instance a ~ () => ParseResponse 'MtUnit a where + parseResponse _ _ = Tagged (return ()) + ------------------------------------------------------------------------------ -- Tools ------------------------------------------------------------------------------ @@ -194,38 +307,17 @@ 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 + :: forall mt rw a m. (MonadThrow m, Accept mt) => Maybe Auth - -> Request k a + -> GenRequest mt rw a -> m HTTP.Request makeHttpRequest auth r = case r of - SimpleQuery req -> - makeHttpSimpleRequest auth req - StatusQuery sm req -> do - req' <- makeHttpSimpleRequest auth req - return $ setCheckStatus (Just sm) req' - HeaderQuery h req -> do - req' <- makeHttpSimpleRequest auth req - return $ req' { requestHeaders = h <> requestHeaders req' } - RedirectQuery req -> do - req' <- makeHttpSimpleRequest auth req - return $ setRequestIgnoreStatus $ req' { redirectCount = 0 } - -makeHttpSimpleRequest - :: MonadThrow m - => Maybe Auth - -> SimpleRequest k a - -> m HTTP.Request -makeHttpSimpleRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . setAuthRequest auth . setQueryString qs $ req @@ -233,7 +325,7 @@ makeHttpSimpleRequest auth r = case r of req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . setAuthRequest auth . setQueryString qs $ req @@ -241,7 +333,7 @@ makeHttpSimpleRequest auth r = case r of req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . setAuthRequest auth . setBody body . setMethod (toMethod m) @@ -266,15 +358,15 @@ makeHttpSimpleRequest auth r = case r of reqHeaders :: RequestHeaders reqHeaders = maybe [] getOAuthHeader auth - <> [("User-Agent", "github.hs/0.7.4")] - <> [("Accept", "application/vnd.github.preview")] + <> [("User-Agent", "github.hs/0.21")] -- 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 + setAuthRequest _ = id getOAuthHeader :: Auth -> RequestHeaders getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] @@ -295,45 +387,6 @@ getNextUrl req = do relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") --- | Parse API response. --- --- @ --- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a --- @ -parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a -parseResponse res = case eitherDecode (responseBody res) of - Right x -> return x - Left err -> throwError . ParseError . T.pack $ err - --- | Helper for handling of 'RequestStatus'. --- --- @ --- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a --- @ -parseStatus :: MonadError Error m => StatusMap a -> Status -> m a -parseStatus m (Status sci _) = - maybe err return $ lookup sci m - where - err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) - --- | Helper for handling of 'RequestRedirect'. --- --- @ --- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a --- @ -parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI -parseRedirect originalUri rsp = do - let status = responseStatus rsp - when (statusCode status /= 302) $ - throwError $ ParseError $ "invalid status: " <> T.pack (show status) - loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp - case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of - Nothing -> throwError $ ParseError $ - "location header does not contain a URI: " <> T.pack (show loc) - Just uri -> return $ uri `relativeTo` originalUri - where - noLocation = throwError $ ParseError "no location header in response" - -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ @@ -344,14 +397,14 @@ parseRedirect originalUri rsp = do -- -> 'ExceptT' 'Error' 'IO' a -- @ performPagedRequest - :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) + :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration -> HTTP.Request -- ^ initial request - -> m a -performPagedRequest httpLbs' predicate initReq = do + -> Tagged mt (m 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 @@ -360,7 +413,7 @@ performPagedRequest httpLbs' predicate initReq = do (True, Just uri) -> do req' <- HTTP.setUri req uri res' <- httpLbs' req' - m <- parseResponse res' + m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' (_, _) -> return acc @@ -368,22 +421,5 @@ performPagedRequest httpLbs' predicate initReq = do -- Internal ------------------------------------------------------------------------------- - -setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } - -successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () -successOrMissing sm _req res - | check = pure () - | otherwise = do - chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024 - let res' = fmap (const ()) res - HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) - where - Status sci _ = HTTP.responseStatus res - check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just sm' -> sci `elem` map fst sm' - onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError From 1d1d6e0e2f1be595bd2b04f267514ef27c24fc88 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Sun, 8 Apr 2018 12:20:01 -0700 Subject: [PATCH 144/309] Commit posisition change --- CHANGELOG.md | 14 +++++++++++++ src/GitHub.hs | 2 +- src/GitHub/Data/Comments.hs | 19 ++++++++++++++++++ src/GitHub/Endpoints/PullRequests/Comments.hs | 20 +++++++++++++++++++ 4 files changed, 54 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d73013a0..ab3b5206 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,8 +2,22 @@ ## Changes for 0.21 +- Refactor `Request` type. + [#349](https://github.com/phadej/github/pull/349) - Allow `http-client-0.6` + [#344](https://github.com/phadej/github/pull/344) - Change to use `cryptohash-sha1` (`cryptohash` was used before) +- Add Create milestone endponts + [#337](https://github.com/phadej/github/pull/337) +- Make fileBlobUrl and fileRawUrl are optional + [#339](https://github.com/phadej/github/issues/339) + [#340](https://github.com/phadej/github/pull/340) +- Add organizationsR to request user organizations + [#345](https://github.com/phadej/github/pull/345) +- Add updateMilestoneR, deleteMilestoneR + [#338](https://github.com/phadej/github/pull/338) +- Allow multiple assignees in NewIssue and EditIssue + [#336](https://github.com/phadej/github/pull/336) ## Changes for 0.20 diff --git a/src/GitHub.hs b/src/GitHub.hs index f38f305f..1f7dbe52 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -206,11 +206,11 @@ module GitHub ( -- Missing endpoints: -- -- * List comments in a repository - -- * Create a comment -- * Edit a comment -- * Delete a comment pullRequestCommentsR, pullRequestCommentR, + createPullCommentR, -- ** Pull request reviews -- | See diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 9c966e7a..91c6d4e5 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -64,3 +64,22 @@ instance Binary EditComment instance ToJSON EditComment where toJSON (EditComment b) = object [ "body" .= b ] + +data NewPullComment = NewPullComment + { newPullCommentCommit :: !Text + , newPullCommentPath :: !Text + , newPullCommentPosition :: !Int + , newPullCommentBody :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewPullComment where rnf = genericRnf +instance Binary NewPullComment + +instance ToJSON NewPullComment where + toJSON (NewPullComment c path pos b) = + object [ "body" .= b + , "commit_id" .= c + , "path" .= path + , "position" .= pos + ] diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 98d5d2c8..d8d3d487 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -10,6 +10,8 @@ module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsR, pullRequestComment, pullRequestCommentR, + createPullComment, + createPullCommentR, module GitHub.Data, ) where @@ -43,3 +45,21 @@ pullRequestComment user repo cid = pullRequestCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment pullRequestCommentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] + +-- | Create a new comment. +-- +-- > createPullComment (User (user, password)) user repo issue commit path position +-- > "some words" +createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text + -> IO (Either Error Comment) +createPullComment auth user repo iss commit path position body = + executeRequest auth $ createPullCommentR user repo iss commit path position body + +-- | Create a comment. +-- +-- See +createPullCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text -> Request 'RW Comment +createPullCommentR user repo iss commit path position body = + command Post parts (encode $ NewPullComment commit path position body) + where + parts = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart iss, "comments"] From 3e768ad95048168e9cf12e6460adbd4c11c24d03 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Thu, 10 May 2018 13:27:12 -0700 Subject: [PATCH 145/309] Add pullRequestPatchR --- CHANGELOG.md | 1 + spec/GitHub/PullRequestsSpec.hs | 8 +++- src/GitHub.hs | 2 + src/GitHub/Data/PullRequests.hs | 4 +- src/GitHub/Endpoints/PullRequests.hs | 64 +++++++++++++++++++++++----- 5 files changed, 65 insertions(+), 14 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ab3b5206..c8ced0de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ [#338](https://github.com/phadej/github/pull/338) - Allow multiple assignees in NewIssue and EditIssue [#336](https://github.com/phadej/github/pull/336) +- Add `pullRequestPatchR` and `pullRequestDiffR` ## Changes for 0.20 diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index cb7a212f..0f08ab22 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -14,6 +14,7 @@ import Data.FileEmbed (embedFile) import Data.Foldable (for_) import Data.String (fromString) import qualified Data.Vector as V +import qualified Data.ByteString.Lazy.Char8 as LBS8 import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) @@ -37,6 +38,12 @@ spec = do GitHub.pullRequestsForR owner repo opts GitHub.FetchAll cs `shouldSatisfy` isRight + describe "pullRequestPatchR" $ + it "works" $ withAuth $ \auth -> do + Right patch <- GitHub.executeRequest auth $ + GitHub.pullRequestPatchR "phadej" "github" (GitHub.IssueNumber 349) + head (LBS8.lines patch) `shouldBe` "From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001" + describe "decoding pull request payloads" $ do it "decodes a pull request 'opened' payload" $ do V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) @@ -62,7 +69,6 @@ spec = do repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") - , ("haskell", "cabal") ] opts = GitHub.stateClosed diff --git a/src/GitHub.hs b/src/GitHub.hs index 1f7dbe52..bbe0d0fa 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -193,6 +193,8 @@ module GitHub ( -- | See pullRequestsForR, pullRequestR, + pullRequestPatchR, + pullRequestDiffR, createPullRequestR, updatePullRequestR, pullRequestCommitsR, diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0c3df02d..b91311da 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -32,7 +32,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL , simplePullRequestState :: !IssueState - , simplePullRequestNumber :: !Int + , simplePullRequestNumber :: !IssueNumber , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !(Maybe Text) @@ -57,7 +57,7 @@ data PullRequest = PullRequest , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL , pullRequestState :: !IssueState - , pullRequestNumber :: !Int + , pullRequestNumber :: !IssueNumber , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !(Maybe Text) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 036ad4d8..e141e589 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -12,6 +12,12 @@ module GitHub.Endpoints.PullRequests ( pullRequest', pullRequest, pullRequestR, + pullRequestDiff', + pullRequestDiff, + pullRequestDiffR, + pullRequestPatch', + pullRequestPatch, + pullRequestPatchR, createPullRequest, createPullRequestR, updatePullRequest, @@ -33,6 +39,7 @@ import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () +import Data.ByteString.Lazy (ByteString) -- | All open pull requests for the repo, by owner and repo name. -- @@ -60,12 +67,47 @@ pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) +-- | Obtain the diff of a pull request +-- See +pullRequestDiff' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestDiff' auth user repo prid = + executeRequestMaybe auth $ pullRequestDiffR user repo prid + +-- | Obtain the diff of a pull request +-- See +pullRequestDiff :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestDiff = pullRequestDiff' Nothing + +-- | Query a single pull request to obtain the diff +-- See +pullRequestDiffR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtDiff rw ByteString +pullRequestDiffR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + +-- | Obtain the patch of a pull request +-- +-- See +pullRequestPatch' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestPatch' auth user repo prid = + executeRequestMaybe auth $ pullRequestPatchR user repo prid + +-- | Obtain the patch of a pull request +-- See +pullRequestPatch :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestPatch = pullRequestPatch' Nothing + +-- | Query a single pull request to obtain the patch +-- See +pullRequestPatchR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtPatch rw ByteString +pullRequestPatchR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + -- | A detailed pull request, which has much more information. This takes the -- repo owner and name along with the number assigned to the pull request. -- With authentification. -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) +pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid @@ -73,12 +115,12 @@ pullRequest' auth user repo prid = -- 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 :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) pullRequest = pullRequest' Nothing -- | 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] [] @@ -100,7 +142,7 @@ 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 -> Name Owner -> Name Repo -> IssueNumber -> EditPullRequest -> IO (Either Error PullRequest) updatePullRequest auth user repo prid epr = executeRequest auth $ updatePullRequestR user repo prid epr @@ -108,7 +150,7 @@ updatePullRequest auth user repo prid epr = -- See updatePullRequestR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> EditPullRequest -> Request 'RW PullRequest updatePullRequestR user repo prid epr = @@ -119,7 +161,7 @@ updatePullRequestR user repo prid epr = -- 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' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll @@ -127,12 +169,12 @@ pullRequestCommits' auth user repo prid = -- the number of the pull request. -- -- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommitsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) +pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] @@ -141,7 +183,7 @@ pullRequestCommitsR user repo prid = -- 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' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll @@ -149,12 +191,12 @@ pullRequestFiles' auth user repo prid = -- 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 :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] From 91cbb4c97948867d68ba9121af014b1f4a6d0eab Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Thu, 10 May 2018 15:26:04 -0700 Subject: [PATCH 146/309] Provide a wrapper for forking outside of the Req monad. --- src/GitHub/Endpoints/Repos.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d9ad44a1..18b883dd 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -38,6 +38,7 @@ module GitHub.Endpoints.Repos ( createRepoR, createOrganizationRepo', createOrganizationRepoR, + forkExistingRepo', forkExistingRepoR, -- ** Edit @@ -167,6 +168,11 @@ createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) +-- | Fork an existing repository. +forkExistingRepo' :: Auth -> Name Owner -> Name Repo -> Maybe (Name Owner) -> IO (Either Error Repo) +forkExistingRepo' auth owner repo morg = + executeRequest auth $ forkExistingRepoR owner repo morg + -- | Fork an existing repository. -- See -- TODO: The third paramater (an optional Organisation) is not used yet. From 1180ebe78b18823317a0c0674d5e92d428ca83be Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 17 Feb 2019 22:13:49 +0200 Subject: [PATCH 147/309] Amend changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c8ced0de..abc96133 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ - Allow multiple assignees in NewIssue and EditIssue [#336](https://github.com/phadej/github/pull/336) - Add `pullRequestPatchR` and `pullRequestDiffR` + [#325](https://github.com/phadej/github/pull/325) ## Changes for 0.20 From dcb707efba9e754eee1639415da2ada6131805c6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Apr 2019 10:33:03 +0300 Subject: [PATCH 148/309] Regenerate .travis.yml --- .travis.yml | 199 +++++++++++++++++++++++++++++---------------------- github.cabal | 2 +- 2 files changed, 114 insertions(+), 87 deletions(-) diff --git a/.travis.yml b/.travis.yml index 82f84f1a..4e9eb83d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,122 +1,149 @@ # This Travis job script has been generated by a script via # -# runghc make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' +# haskell-ci '--branches' 'master' '-o' '.travis.yml' 'github.cabal' # # For more information, see https://github.com/haskell-CI/haskell-ci # +# version: 0.3.20190327 +# language: c -sudo: false - +dist: xenial git: - submodules: false # whether to recursively clone submodules - + # whether to recursively clone submodules + submodules: false branches: only: - master - cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store - before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - - - rm -rfv $HOME/.cabal/packages/head.hackage - + - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* + - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx + - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - - compiler: "ghc-8.6.1" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}} - - compiler: "ghc-8.4.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.3], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.0.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-7.10.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}} - - compiler: "ghc-7.8.4" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}} - + - compiler: ghc-8.6.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.3","cabal-install-2.4"]}} + - compiler: ghc-8.4.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}} + - compiler: ghc-8.2.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}} + - compiler: ghc-8.0.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}} + - compiler: ghc-7.10.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}} + - compiler: ghc-7.8.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}} before_install: - - HC=${CC} - - HCPKG=${HC/ghc/ghc-pkg} + - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') + - HCPKG="$HC-pkg" - unset CC - - ROOTDIR=$(pwd) - - mkdir -p $HOME/.local/bin - - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - CABAL=/opt/ghc/bin/cabal + - CABALHOME=$HOME/.cabal + - export PATH="$CABALHOME/bin:$PATH" + - TOP=$(pwd) - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - echo $HCNUMVER - + - CABAL="$CABAL -vnormal+nowrap+markoutput" + - set -o pipefail + - | + echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk + echo 'BEGIN { state = "output"; }' >> .colorful.awk + echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk + echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk + echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk + echo ' if (state == "cabal") {' >> .colorful.awk + echo ' print blue($0)' >> .colorful.awk + echo ' } else {' >> .colorful.awk + echo ' print $0' >> .colorful.awk + echo ' }' >> .colorful.awk + echo '}' >> .colorful.awk + - cat .colorful.awk + - | + color_cabal_output () { + awk -f $TOP/.colorful.awk + } + - echo text | color_cabal_output install: - - cabal --version + - ${CABAL} --version - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - HADDOCK=${HADDOCK-true} - - UNCONSTRAINED=${UNCONSTRAINED-true} - - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} + - TEST=--enable-tests + - BENCH=--enable-benchmarks - GHCHEAD=${GHCHEAD-false} - - travis_retry cabal update -v - - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - - rm -fv cabal.project cabal.project.local - - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - - "printf 'packages: \".\"\\n' > cabal.project" - - touch cabal.project.local - - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + - rm -f $CABALHOME/config + - | + echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config + echo "remote-build-reporting: anonymous" >> $CABALHOME/config + echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config + echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config + echo "world-file: $CABALHOME/world" >> $CABALHOME/config + echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config + echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config + echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config + echo "store-dir: $CABALHOME/store" >> $CABALHOME/config + echo "install-dirs user" >> $CABALHOME/config + echo " prefix: $CABALHOME" >> $CABALHOME/config + echo "repository hackage.haskell.org" >> $CABALHOME/config + echo " url: http://hackage.haskell.org/" >> $CABALHOME/config + - cat $CABALHOME/config + - rm -fv cabal.project cabal.project.local cabal.project.freeze + - travis_retry ${CABAL} v2-update -v + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo 'packages: "."' >> cabal.project + - | + echo "write-ghc-environment-files: always" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then - (cd "." && autoreconf -i); - fi - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf .ghc.environment.* "."/dist - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - -# 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. + - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi + - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output + - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" + - rm cabal.project.freeze + - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output + - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output script: - # test that source-distributions can be generated - - (cd "." && cabal sdist) - - mv "."/dist/github-*.tar.gz ${DISTDIR}/ + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + # Packaging... + - ${CABAL} v2-sdist all | color_cabal_output + # Unpacking... + - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - "printf 'packages: github-*/*.cabal\\n' > cabal.project" - - touch cabal.project.local - - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo 'packages: "github-*/*.cabal"' >> cabal.project + - | + echo "write-ghc-environment-files: always" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true + # Building... # this builds all libraries and executables (without tests/benchmarks) - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - + - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output + # Building with tests and benchmarks... # build & run tests, build benchmarks - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi - - # cabal check - - (cd github-* && cabal check) - - # haddock - - rm -rf ./dist-newstyle - - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi - - # Build without installed constraints for packages in global-db - - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + # Testing... + - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + # cabal check... + - (cd github-* && ${CABAL} -vnormal check) + # haddock... + - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + # Building without installed constraints for packages in global-db... + - rm -f cabal.project.local + - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output -# REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] +# REGENDATA ["--branches","master","-o",".travis.yml","github.cabal"] # EOF diff --git a/github.cabal b/github.cabal index 36b9dd3b..df12bf1d 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.3 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.4 extra-source-files: README.md From b4c52584ef6d534f4abe33fd935f60af7537e0fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 5 Apr 2019 08:02:40 +0200 Subject: [PATCH 149/309] Fix examples in documentation --- github.cabal | 2 +- src/GitHub.hs | 2 +- src/GitHub/Data.hs | 2 +- src/GitHub/Endpoints/Activity/Watching.hs | 4 ++-- src/GitHub/Endpoints/Gists.hs | 10 ++++----- src/GitHub/Endpoints/GitData/Blobs.hs | 2 +- src/GitHub/Endpoints/GitData/References.hs | 2 +- src/GitHub/Endpoints/GitData/Trees.hs | 4 ++-- src/GitHub/Endpoints/Issues.hs | 8 +++---- src/GitHub/Endpoints/Issues/Comments.hs | 8 +++---- src/GitHub/Endpoints/Issues/Events.hs | 6 ++--- src/GitHub/Endpoints/Issues/Labels.hs | 22 +++++++++---------- src/GitHub/Endpoints/Issues/Milestones.hs | 2 +- src/GitHub/Endpoints/Organizations.hs | 4 ++-- src/GitHub/Endpoints/PullRequests.hs | 6 ++--- src/GitHub/Endpoints/PullRequests/Comments.hs | 2 +- src/GitHub/Endpoints/PullRequests/Reviews.hs | 8 +++---- src/GitHub/Endpoints/Repos.hs | 16 +++++++------- src/GitHub/Endpoints/Repos/Commits.hs | 6 ++--- src/GitHub/Endpoints/Repos/Contents.hs | 6 ++--- src/GitHub/Endpoints/Repos/Forks.hs | 2 +- src/GitHub/Endpoints/Repos/Releases.hs | 8 +++---- src/GitHub/Endpoints/Users.hs | 2 +- src/GitHub/Internal/Prelude.hs | 2 +- src/GitHub/Request.hs | 2 +- 25 files changed, 69 insertions(+), 69 deletions(-) diff --git a/github.cabal b/github.cabal index df12bf1d..225ac17e 100644 --- a/github.cabal +++ b/github.cabal @@ -15,7 +15,7 @@ description: > > main :: IO () > main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" + > possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" > print possibleUser . For more of an overview please see the README: diff --git a/src/GitHub.hs b/src/GitHub.hs index bbe0d0fa..078a62f7 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -7,7 +7,7 @@ -- this package. -- -- See "GitHub.Request" module for executing 'Request', or other modules --- of this package (e.g. "GitHub.Users") for already composed versions. +-- of this package (e.g. "GitHub.Endpoints.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 3f031a07..e6fbd4a0 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -4,7 +4,7 @@ -- 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 diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 34914e32..d250878e 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -30,7 +30,7 @@ watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- --- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" +-- > watchersFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo FetchAll @@ -50,7 +50,7 @@ reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- --- > reposWatchedBy' (Just (User (user, password))) "croaky" +-- > reposWatchedBy' (Just $ BasicAuth "github-username" "github-password") "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = executeRequestMaybe auth $ reposWatchedByR user FetchAll diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 13c830a3..c59ba5c5 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -27,7 +27,7 @@ import Prelude () -- | The list of all gists created by the user -- --- > gists' (Just ("github-username", "github-password")) "mike-burns" +-- > gists' (Just $ BasicAuth "github-username" "github-password") "mike-burns" gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = executeRequestMaybe auth $ gistsR user FetchAll @@ -45,7 +45,7 @@ gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- --- > gist' (Just ("github-username", "github-password")) "225074" +-- > gist' (Just $ BasicAuth "github-username" "github-password") "225074" gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) gist' auth gid = executeRequestMaybe auth $ gistR gid @@ -64,7 +64,7 @@ gistR gid = -- | Star a gist by the authenticated user. -- --- > starGist ("github-username", "github-password") "225074" +-- > starGist (BasicAuth "github-username" "github-password") "225074" starGist :: Auth -> Name Gist -> IO (Either Error ()) starGist auth gid = executeRequest auth $ starGistR gid @@ -75,7 +75,7 @@ starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty -- | Unstar a gist by the authenticated user. -- --- > unstarGist ("github-username", "github-password") "225074" +-- > unstarGist (BasicAuth "github-username" "github-password") "225074" unstarGist :: Auth -> Name Gist -> IO (Either Error ()) unstarGist auth gid = executeRequest auth $ unstarGistR gid @@ -86,7 +86,7 @@ unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty -- | Delete a gist by the authenticated user. -- --- > deleteGist ("github-username", "github-password") "225074" +-- > deleteGist (BasicAuth "github-username" "github-password") "225074" deleteGist :: Auth -> Name Gist -> IO (Either Error ()) deleteGist auth gid = executeRequest auth $ deleteGistR gid diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 355a6e8a..1de49084 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -19,7 +19,7 @@ import Prelude () -- | Query a blob by SHA1. -- --- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" +-- > blob' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob' auth user repo sha = executeRequestMaybe auth $ blobR user repo sha diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index d010e1b7..ba5e7bc8 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -26,7 +26,7 @@ import Prelude () -- | A single reference by the ref name. -- --- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" +-- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference' auth user repo ref = executeRequestMaybe auth $ referenceR user repo ref diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 1806561a..b6bc550a 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -22,7 +22,7 @@ import Prelude () -- | A tree for a SHA1. -- --- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +-- > tree (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree' auth user repo sha = executeRequestMaybe auth $ treeR user repo sha @@ -41,7 +41,7 @@ treeR user repo sha = -- | A recursively-nested tree for a SHA1. -- --- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +-- > nestedTree' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree' auth user repo sha = executeRequestMaybe auth $ nestedTreeR user repo sha diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 7b2c5c43..92e73bbc 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -41,7 +41,7 @@ organizationIssuesR org opts = -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' -- --- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" +-- > issue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "462" issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue' auth user reqRepoName reqIssueNumber = executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber @@ -62,7 +62,7 @@ issueR user reqRepoName reqIssueNumber = -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. -- --- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] +-- > issuesForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName opts = executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll @@ -90,7 +90,7 @@ newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create a new issue. -- --- > createIssue (User (user, password)) user repo +-- > createIssue (BasicAuth "github-username" "github-password") user repo -- > (newIssue "some_repo") {...} createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue -> IO (Either Error Issue) @@ -110,7 +110,7 @@ editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- --- > editIssue (User (user, password)) user repo issue +-- > editIssue (BasicAuth "github-username" "github-password") user repo issue -- > editOfIssue {...} editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue -> IO (Either Error Issue) diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 7b46fc0b..83f67024 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -46,7 +46,7 @@ comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- --- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 +-- > comments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 635 comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid FetchAll @@ -59,7 +59,7 @@ commentsR user repo iid = -- | Create a new comment. -- --- > createComment (User (user, password)) user repo issue +-- > createComment (BasicAuth "github-username" "github-password") user repo issue -- > "some words" createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> IO (Either Error Comment) @@ -76,7 +76,7 @@ createCommentR user repo iss body = -- | Edit a comment. -- --- > editComment (User (user, password)) user repo commentid +-- > editComment (BasicAuth "github-username" "github-password") user repo commentid -- > "new words" editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text -> IO (Either Error Comment) @@ -93,7 +93,7 @@ editCommentR user repo commid body = -- | Delete a comment. -- --- > deleteComment (User (user, password)) user repo commentid +-- > deleteComment (BasicAuth "github-username" "github-password") user repo commentid deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error ()) deleteComment auth user repo commid = diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 97750eda..c139f819 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -31,7 +31,7 @@ eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- --- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 +-- > eventsForIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 49 eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll @@ -50,7 +50,7 @@ eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- --- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" +-- > eventsForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo FetchAll @@ -69,7 +69,7 @@ event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- --- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 +-- > event' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 5335772 event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 4b4c8628..6fa03ed3 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -48,7 +48,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll @@ -67,7 +67,7 @@ label = label' Nothing -- | A label by name using authentication. -- --- > label' (Just (User (user password))) "thoughtbot" "paperclip" "bug" +-- > label' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label' auth user repo lbl = executeRequestMaybe auth $ labelR user repo lbl @@ -80,7 +80,7 @@ labelR user repo lbl = -- | Create a label -- --- > createLabel (User (user password)) "thoughtbot" "paperclip" "bug" "f29513" +-- > createLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "f29513" createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) createLabel auth user repo lbl color = executeRequest auth $ createLabelR user repo lbl color @@ -96,7 +96,7 @@ createLabelR user repo lbl color = -- | Update a label -- --- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" +-- > updateLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" updateLabel :: Auth -> Name Owner -> Name Repo @@ -123,7 +123,7 @@ updateLabelR user repo oldLbl newLbl color = -- | Delete a label -- --- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug" +-- > deleteLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) deleteLabel auth user repo lbl = executeRequest auth $ deleteLabelR user repo lbl @@ -142,7 +142,7 @@ labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- --- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) +-- > labelsOnIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll @@ -155,7 +155,7 @@ labelsOnIssueR user repo iid = -- | Add labels to an issue. -- --- > addLabelsToIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +-- > addLabelsToIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] addLabelsToIssue :: Foldable f => Auth -> Name Owner @@ -181,7 +181,7 @@ addLabelsToIssueR user repo iid lbls = -- | Remove a label from an issue. -- --- > removeLabelFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) "bug" +-- > removeLabelFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) "bug" removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) removeLabelFromIssue auth user repo iid lbl = executeRequest auth $ removeLabelFromIssueR user repo iid lbl @@ -194,7 +194,7 @@ removeLabelFromIssueR user repo iid lbl = -- | 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 (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] replaceAllLabelsForIssue :: Foldable f => Auth -> Name Owner @@ -222,7 +222,7 @@ replaceAllLabelsForIssueR user repo iid lbls = -- | Remove all labels from an issue. -- --- > removeAllLabelsFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) +-- > removeAllLabelsFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ()) removeAllLabelsFromIssue auth user repo iid = executeRequest auth $ removeAllLabelsFromIssueR user repo iid @@ -241,7 +241,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 2) labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 06039dd2..282de6c9 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -33,7 +33,7 @@ milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- --- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" +-- > milestones' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = executeRequestMaybe auth $ milestonesR user repo FetchAll diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index ada7052b..ee1f5557 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -22,7 +22,7 @@ import Prelude () -- | The public organizations for a user, given the user's login, with authorization -- --- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" +-- > publicOrganizationsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org FetchAll @@ -45,7 +45,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index e141e589..88409839 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -106,7 +106,7 @@ pullRequestPatchR user repo prid = -- 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 562 pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid @@ -160,7 +160,7 @@ updatePullRequestR user repo prid epr = -- the number of the pull request. -- With authentification. -- --- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 +-- > pullRequestCommits' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll @@ -182,7 +182,7 @@ pullRequestCommitsR user repo prid = -- name, plus the number assigned to the pull request. -- With authentification. -- --- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 +-- > pullRequestFiles' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index d8d3d487..52103030 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -48,7 +48,7 @@ pullRequestCommentR user repo cid = -- | Create a new comment. -- --- > createPullComment (User (user, password)) user repo issue commit path position +-- > createPullComment (BasicAuth "github-username" "github-password") user repo issue commit path position -- > "some words" createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text -> IO (Either Error Comment) diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 50b433fd..2143dcd5 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -58,7 +58,7 @@ pullRequestReviews owner repo prid = -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. With authentication. -- --- > pullRequestReviews' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) +-- > pullRequestReviews' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 101) pullRequestReviews' :: Maybe Auth -> Name Owner @@ -104,8 +104,8 @@ pullRequestReview owner repo prid rid = -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. With authentication. -- --- > pullRequestReview' (Just ("github-username", "github-password")) --- "thoughtbot" "factory_girl" (Id 301819) (Id 332) +-- > pullRequestReview' (Just $ BasicAuth "github-username" "github-password") +-- > "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview' :: Maybe Auth -> Name Owner @@ -153,7 +153,7 @@ pullRequestReviewCommentsIO owner repo prid rid = -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. With authentication. -- --- > pullRequestReviewComments' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) +-- > pullRequestReviewComments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 18b883dd..0c1cd83f 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -88,7 +88,7 @@ userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- --- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All +-- > userRepos' (Just $ BasicAuth "github-username" "github-password") "mike-burns" All userRepos' :: Maybe Auth -> Name Owner @@ -114,7 +114,7 @@ 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 (Just $ BasicAuth "github-username" "github-password") "thoughtbot" All organizationRepos' :: Maybe Auth -> Name Organization @@ -144,7 +144,7 @@ repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- --- > repository' (Just (BasicAuth (user, password))) "mike-burns" "github" +-- > repository' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo @@ -224,7 +224,7 @@ contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- --- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +-- > contributors' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = executeRequestMaybe auth $ contributorsR user repo False FetchAll @@ -256,7 +256,7 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- and repo name. -- With authentication. -- --- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +-- > contributorsWithAnonymous' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = executeRequestMaybe auth $ contributorsR user repo True FetchAll @@ -272,7 +272,7 @@ languagesFor = languagesFor' Nothing -- characters written in that language. Takes the repo owner and name. -- With authentication. -- --- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch" +-- > languagesFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "ohlaunch" languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor' auth user repo = executeRequestMaybe auth $ languagesForR user repo @@ -292,7 +292,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = executeRequestMaybe auth $ tagsForR user repo FetchAll @@ -312,7 +312,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = executeRequestMaybe auth $ branchesForR user repo FetchAll diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index ba86ed40..affa5044 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -48,7 +48,7 @@ commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- --- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" +-- > commitsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] @@ -65,7 +65,7 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- query options. -- With authentication. -- --- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] +-- > commitsWithOptionsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts @@ -88,7 +88,7 @@ commit = commit' Nothing -- | Details on a specific SHA1 for a repo. -- With authentication. -- --- > commit (Just $ BasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" +-- > commit (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit' auth user repo sha = executeRequestMaybe auth $ commitR user repo sha diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 39c9a408..b1e05ebe 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -50,7 +50,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "README.md" Nothing contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) contentsFor' auth user repo path ref = executeRequestMaybe auth $ contentsForR user repo path ref @@ -75,7 +75,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) readmeFor' auth user repo = executeRequestMaybe auth $ readmeForR user repo @@ -93,7 +93,7 @@ archiveFor = archiveFor' Nothing -- | The archive of a repo, given the repo owner, name, and archive type -- With Authentication -- --- > archiveFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" ArchiveFormatTarball Nothing +-- > archiveFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" ArchiveFormatTarball Nothing archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) archiveFor' auth user repo path ref = executeRequestMaybe auth $ archiveForR user repo path ref diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index b5cad183..5ca6ac14 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -26,7 +26,7 @@ forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- --- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" +-- > forksFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = executeRequestMaybe auth $ forksForR user repo FetchAll diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs index 462060f4..9c0e4ed4 100644 --- a/src/GitHub/Endpoints/Repos/Releases.hs +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -29,7 +29,7 @@ releases = releases' Nothing -- | All releases for the given repo with authentication. -- --- > releases' (Just (User (user, password))) "calleerlandsson" "pick" +-- > releases' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) releases' auth user repo = executeRequestMaybe auth $ releasesR user repo FetchAll @@ -48,7 +48,7 @@ release = release' Nothing -- | Query a single release with authentication. -- --- > release' (Just (User (user, password))) "calleerlandsson" "pick" +-- > release' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) release' auth user repo reqReleaseId = executeRequestMaybe auth $ releaseR user repo reqReleaseId @@ -67,7 +67,7 @@ latestRelease = latestRelease' Nothing -- | Query latest release with authentication. -- --- > latestRelease' (Just (User (user, password))) "calleerlandsson" "pick" +-- > latestRelease' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) latestRelease' auth user repo = executeRequestMaybe auth $ latestReleaseR user repo @@ -86,7 +86,7 @@ releaseByTagName = releaseByTagName' Nothing -- | Query release by tag name with authentication. -- --- > releaseByTagName' (Just (User (user, password))) "calleerlandsson" "pick" +-- > releaseByTagName' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) releaseByTagName' auth user repo reqTagName = executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index f7dfdf07..b3f7621c 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -23,7 +23,7 @@ import Prelude () -- | The information for a single user, by login name. -- With authentification -- --- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" +-- > userInfoFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 70ba2395..0a227092 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -4,7 +4,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module may change between minor releases. Do not rely on it contents. +-- This module may change between minor releases. Do not rely on its contents. module GitHub.Internal.Prelude ( module Prelude.Compat, -- * Commonly used types diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 424b3e11..a93f4351 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -208,7 +208,7 @@ instance FromJSON a => ParseResponse 'MtStar a where parseResponse _ res = Tagged (parseResponseJSON res) ------------------------------------------------------------------------------- --- Raw / Diff / Patch / Sha +-- Raw / Diff / Patch / Sha ------------------------------------------------------------------------------- instance Accept 'MtRaw where contentType = Tagged "application/vnd.github.v3.raw" From 82a223c0afb989622b92056746dd2312f866f972 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Wed, 24 Apr 2019 23:41:31 +1000 Subject: [PATCH 150/309] Add missing webhook event types --- src/GitHub/Data/Webhooks.hs | 84 +++++++++++++++++++++++++++++++++++-- 1 file changed, 81 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 9e8d1c4b..6ddcb504 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -31,26 +31,52 @@ instance Binary RepoWebhook data RepoWebhookEvent = WebhookWildcardEvent + | WebhookCheckRunEvent + | WebhookCheckSuiteEvent | WebhookCommitCommentEvent + | WebhookContentReferenceEvent | WebhookCreateEvent | WebhookDeleteEvent + | WebhookDeployKeyEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent + | WebhookDownloadEvent + | WebhookFollowEvent | WebhookForkEvent + | WebhookForkApplyEvent + | WebhookGitHubAppAuthorizationEvent + | WebhookGistEvent | WebhookGollumEvent | WebhookInstallationEvent | WebhookInstallationRepositoriesEvent | WebhookIssueCommentEvent | WebhookIssuesEvent + | WebhookLabelEvent + | WebhookMarketplacePurchaseEvent | WebhookMemberEvent + | WebhookMembershipEvent + | WebhookMetaEvent + | WebhookMilestoneEvent + | WebhookOrganizationEvent + | WebhookOrgBlockEvent | WebhookPageBuildEvent | WebhookPingEvent + | WebhookProjectCardEvent + | WebhookProjectColumnEvent + | WebhookProjectEvent | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent | WebhookPullRequestEvent + | WebhookPullRequestReviewEvent + | WebhookPullRequestReviewCommentEvent | WebhookPushEvent | WebhookReleaseEvent + | WebhookRepositoryEvent + | WebhookRepositoryImportEvent + | WebhookRepositoryVulnerabilityAlertEvent + | WebhookSecurityAdvisoryEvent + | WebhookStarEvent | WebhookStatusEvent + | WebhookTeamEvent | WebhookTeamAddEvent | WebhookWatchEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -105,52 +131,104 @@ instance Binary EditRepoWebhook instance FromJSON RepoWebhookEvent where parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "check_run") = pure WebhookCheckRunEvent + parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "content_reference") = pure WebhookContentReferenceEvent parseJSON (String "create") = pure WebhookCreateEvent parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent parseJSON (String "deployment") = pure WebhookDeploymentEvent parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "download") = pure WebhookDownloadEvent + parseJSON (String "follow") = pure WebhookFollowEvent parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "fork_apply") = pure WebhookForkApplyEvent + parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent + parseJSON (String "gist") = pure WebhookGistEvent parseJSON (String "gollum") = pure WebhookGollumEvent parseJSON (String "installation") = pure WebhookInstallationEvent parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "label") = pure WebhookLabelEvent + parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "membership") = pure WebhookMembershipEvent + parseJSON (String "meta") = pure WebhookMetaEvent + parseJSON (String "milestone") = pure WebhookMilestoneEvent + parseJSON (String "organization") = pure WebhookOrganizationEvent + parseJSON (String "org_block") = pure WebhookOrgBlockEvent parseJSON (String "page_build") = pure WebhookPageBuildEvent parseJSON (String "ping") = pure WebhookPingEvent + parseJSON (String "project_card") = pure WebhookProjectCardEvent + parseJSON (String "project_column") = pure WebhookProjectColumnEvent + parseJSON (String "project") = pure WebhookProjectEvent parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "push") = pure WebhookPushEvent parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "repository") = pure WebhookRepositoryEvent + parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent + parseJSON (String "repository_vulnerability_alert") = pure WebhookRepositoryVulnerabilityAlertEvent + parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent + parseJSON (String "star") = pure WebhookStarEvent parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team") = pure WebhookTeamEvent parseJSON (String "team_add") = pure WebhookTeamAddEvent parseJSON (String "watch") = pure WebhookWatchEvent parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCheckRunEvent = String "check_run" + toJSON WebhookCheckSuiteEvent = String "check_suite" toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookContentReferenceEvent = String "content_reference" toJSON WebhookCreateEvent = String "create" toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeployKeyEvent = String "deploy_key" toJSON WebhookDeploymentEvent = String "deployment" toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookDownloadEvent = String "download" + toJSON WebhookFollowEvent = String "follow" toJSON WebhookForkEvent = String "fork" + toJSON WebhookForkApplyEvent = String "fork_apply" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" + toJSON WebhookGistEvent = String "gist" toJSON WebhookGollumEvent = String "gollum" toJSON WebhookInstallationEvent = String "installation" toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" toJSON WebhookIssueCommentEvent = String "issue_comment" toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookLabelEvent = String "label" + toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" toJSON WebhookMemberEvent = String "member" + toJSON WebhookMembershipEvent = String "membership" + toJSON WebhookMetaEvent = String "meta" + toJSON WebhookMilestoneEvent = String "milestone" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookOrgBlockEvent = String "org_block" toJSON WebhookPageBuildEvent = String "page_build" toJSON WebhookPingEvent = String "ping" + toJSON WebhookProjectCardEvent = String "project_card" + toJSON WebhookProjectColumnEvent = String "project_column" + toJSON WebhookProjectEvent = String "project" toJSON WebhookPublicEvent = String "public" - toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPushEvent = String "push" toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryEvent = String "repository" + toJSON WebhookRepositoryImportEvent = String "repository_import" + toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" + toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookStarEvent = String "star" toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamEvent = String "team" toJSON WebhookTeamAddEvent = String "team_add" toJSON WebhookWatchEvent = String "watch" From 90848831f7baef332d9d67d8bfc96662a2586676 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Wed, 24 Apr 2019 23:43:08 +1000 Subject: [PATCH 151/309] Fix RepoWebhookEvent ToJSON instance indentation --- src/GitHub/Data/Webhooks.hs | 96 ++++++++++++++++++------------------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 6ddcb504..ce28e2d6 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -182,55 +182,55 @@ instance FromJSON RepoWebhookEvent where parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where - toJSON WebhookWildcardEvent = String "*" - toJSON WebhookCheckRunEvent = String "check_run" - toJSON WebhookCheckSuiteEvent = String "check_suite" - toJSON WebhookCommitCommentEvent = String "commit_comment" - toJSON WebhookContentReferenceEvent = String "content_reference" - toJSON WebhookCreateEvent = String "create" - toJSON WebhookDeleteEvent = String "delete" - toJSON WebhookDeployKeyEvent = String "deploy_key" - toJSON WebhookDeploymentEvent = String "deployment" - toJSON WebhookDeploymentStatusEvent = String "deployment_status" - toJSON WebhookDownloadEvent = String "download" - toJSON WebhookFollowEvent = String "follow" - toJSON WebhookForkEvent = String "fork" - toJSON WebhookForkApplyEvent = String "fork_apply" - toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" - toJSON WebhookGistEvent = String "gist" - toJSON WebhookGollumEvent = String "gollum" - toJSON WebhookInstallationEvent = String "installation" - toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" - toJSON WebhookIssueCommentEvent = String "issue_comment" - toJSON WebhookIssuesEvent = String "issues" - toJSON WebhookLabelEvent = String "label" - toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" - toJSON WebhookMemberEvent = String "member" - toJSON WebhookMembershipEvent = String "membership" - toJSON WebhookMetaEvent = String "meta" - toJSON WebhookMilestoneEvent = String "milestone" - toJSON WebhookOrganizationEvent = String "organization" - toJSON WebhookOrgBlockEvent = String "org_block" - toJSON WebhookPageBuildEvent = String "page_build" - toJSON WebhookPingEvent = String "ping" - toJSON WebhookProjectCardEvent = String "project_card" - toJSON WebhookProjectColumnEvent = String "project_column" - toJSON WebhookProjectEvent = String "project" - toJSON WebhookPublicEvent = String "public" - toJSON WebhookPullRequestEvent = String "pull_request" - toJSON WebhookPullRequestReviewEvent = String "pull_request_review" - toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" - toJSON WebhookPushEvent = String "push" - toJSON WebhookReleaseEvent = String "release" - toJSON WebhookRepositoryEvent = String "repository" - toJSON WebhookRepositoryImportEvent = String "repository_import" + toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCheckRunEvent = String "check_run" + toJSON WebhookCheckSuiteEvent = String "check_suite" + toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookContentReferenceEvent = String "content_reference" + toJSON WebhookCreateEvent = String "create" + toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeployKeyEvent = String "deploy_key" + toJSON WebhookDeploymentEvent = String "deployment" + toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookDownloadEvent = String "download" + toJSON WebhookFollowEvent = String "follow" + toJSON WebhookForkEvent = String "fork" + toJSON WebhookForkApplyEvent = String "fork_apply" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" + toJSON WebhookGistEvent = String "gist" + toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookInstallationEvent = String "installation" + toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" + toJSON WebhookIssueCommentEvent = String "issue_comment" + toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookLabelEvent = String "label" + toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" + toJSON WebhookMemberEvent = String "member" + toJSON WebhookMembershipEvent = String "membership" + toJSON WebhookMetaEvent = String "meta" + toJSON WebhookMilestoneEvent = String "milestone" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookOrgBlockEvent = String "org_block" + toJSON WebhookPageBuildEvent = String "page_build" + toJSON WebhookPingEvent = String "ping" + toJSON WebhookProjectCardEvent = String "project_card" + toJSON WebhookProjectColumnEvent = String "project_column" + toJSON WebhookProjectEvent = String "project" + toJSON WebhookPublicEvent = String "public" + toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPushEvent = String "push" + toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryEvent = String "repository" + toJSON WebhookRepositoryImportEvent = String "repository_import" toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" - toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" - toJSON WebhookStarEvent = String "star" - toJSON WebhookStatusEvent = String "status" - toJSON WebhookTeamEvent = String "team" - toJSON WebhookTeamAddEvent = String "team_add" - toJSON WebhookWatchEvent = String "watch" + toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookStarEvent = String "star" + toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamEvent = String "team" + toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookWatchEvent = String "watch" instance FromJSON RepoWebhook where parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook From 9f367d18e12a457831190b287345e2eec4f9d7df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Sicard-Ram=C3=ADrez?= Date: Sat, 11 May 2019 09:33:27 -0500 Subject: [PATCH 152/309] Tested with semigroups 0.19. --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 225ac17e..4b098b9c 100644 --- a/github.cabal +++ b/github.cabal @@ -166,7 +166,7 @@ library , http-types >=0.12.1 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 - , semigroups >=0.18.5 && <0.19 + , semigroups >=0.18.5 && <0.20 , tagged , tls >=1.4.1 , transformers-compat >=0.6 && <0.7 From 8b0ddfd8af91f2ace894a30a6879273cc87fba64 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Thu, 16 May 2019 01:42:00 +1000 Subject: [PATCH 153/309] Type class for different auth methods --- src/GitHub/Auth.hs | 38 ++++++++++++++++++++++++++------- src/GitHub/Request.hs | 49 +++++++++++++++++++------------------------ 2 files changed, 52 insertions(+), 35 deletions(-) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index c197fb4a..7918c0af 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -3,24 +3,48 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module GitHub.Auth where +module GitHub.Auth ( + Auth (..), + AuthMethod, + endpoint, + setAuthRequest + ) where import GitHub.Internal.Prelude import Prelude () -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS +import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString -- | The Github auth data type data Auth - = BasicAuth BS.ByteString BS.ByteString - | OAuth Token -- ^ token - | EnterpriseOAuth Text -- custom API endpoint without - -- trailing slash - Token -- token + = BasicAuth BS.ByteString BS.ByteString -- ^ Username and password + | OAuth Token -- ^ OAuth token + | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Auth where rnf = genericRnf instance Binary Auth instance Hashable Auth + +-- | A type class for different authentication methods +class AuthMethod a where + -- | Custom API endpoint without trailing slash + endpoint :: a -> Maybe Text + -- | A function which sets authorisation on an HTTP request + setAuthRequest :: a -> HTTP.Request -> HTTP.Request + +instance AuthMethod Auth where + endpoint (BasicAuth _ _) = Nothing + endpoint (OAuth _) = Nothing + endpoint (EnterpriseOAuth e _) = Just e + + setAuthRequest (BasicAuth u p) = HTTP.applyBasicAuth u p + setAuthRequest (OAuth t) = setAuthHeader $ "token " <> t + setAuthRequest (EnterpriseOAuth _ t) = setAuthHeader $ "token " <> t + +setAuthHeader :: BS.ByteString -> HTTP.Request -> HTTP.Request +setAuthHeader auth req = + req { HTTP.requestHeaders = ("Authorization", auth) : HTTP.requestHeaders req } diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a93f4351..4eb28fc7 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -84,13 +84,17 @@ import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP -import GitHub.Auth (Auth (..)) +import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request -- | Execute 'Request' in 'IO' -executeRequest :: ParseResponse mt a => Auth -> GenRequest mt rw a -> IO (Either Error a) +executeRequest + :: (AuthMethod am, ParseResponse mt a) + => am + -> GenRequest mt rw a + -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req @@ -101,9 +105,9 @@ lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr - :: ParseResponse mt a + :: (AuthMethod am, ParseResponse mt a) => Manager - -> Auth + -> am -> GenRequest mt rw a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ do @@ -140,7 +144,7 @@ executeRequestWithMgr' -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ do - httpReq <- makeHttpRequest Nothing req + httpReq <- makeHttpRequest (Nothing :: Maybe Auth) req performHttpReq httpReq req where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) @@ -158,7 +162,11 @@ executeRequestWithMgr' mgr req = runExceptT $ do -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: ParseResponse mt a => Maybe Auth -> GenRequest mt 'RO a -> IO (Either Error a) +executeRequestMaybe + :: (AuthMethod am, ParseResponse mt a) + => Maybe am + -> GenRequest mt 'RO a + -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. @@ -308,8 +316,8 @@ instance a ~ () => ParseResponse 'MtUnit a where -- status checking is modifying accordingly. -- makeHttpRequest - :: forall mt rw a m. (MonadThrow m, Accept mt) - => Maybe Auth + :: 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 @@ -318,7 +326,7 @@ makeHttpRequest auth r = case r of return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) - . setAuthRequest auth + . maybe id setAuthRequest auth . setQueryString qs $ req PagedQuery paths qs _ -> do @@ -326,7 +334,7 @@ makeHttpRequest auth r = case r of return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) - . setAuthRequest auth + . maybe id setAuthRequest auth . setQueryString qs $ req Command m paths body -> do @@ -334,7 +342,7 @@ makeHttpRequest auth r = case r of return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) - . setAuthRequest auth + . maybe id setAuthRequest auth . setBody body . setMethod (toMethod m) $ req @@ -343,12 +351,7 @@ makeHttpRequest auth r = case r of parseUrl' = HTTP.parseRequest . T.unpack url :: Paths -> Text - url paths = baseUrl <> "/" <> T.intercalate "/" paths - - baseUrl :: Text - baseUrl = case auth of - Just (EnterpriseOAuth endpoint _) -> endpoint - _ -> "https://api.github.com" + url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } @@ -357,22 +360,12 @@ makeHttpRequest auth r = case r of setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = maybe [] getOAuthHeader auth - <> [("User-Agent", "github.hs/0.21")] -- Version + reqHeaders = [("User-Agent", "github.hs/0.21")] -- 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 _ = [] - -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do From 20f9f39cd7f620bdd01909d6e394a3aac4c5aaad Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 23 May 2019 17:33:08 +0300 Subject: [PATCH 154/309] Add Webhook events doc link --- src/GitHub/Data/Webhooks.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index ce28e2d6..c2595fa8 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -29,6 +29,7 @@ data RepoWebhook = RepoWebhook instance NFData RepoWebhook where rnf = genericRnf instance Binary RepoWebhook +-- | See . data RepoWebhookEvent = WebhookWildcardEvent | WebhookCheckRunEvent From 3be11c12496f5b6a5941e8308ffd7bbcfa16de82 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 23 May 2019 21:44:42 +0300 Subject: [PATCH 155/309] Raise bounds --- github.cabal | 17 ++++++++++------- src/GitHub/Internal/Prelude.hs | 2 +- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/github.cabal b/github.cabal index 4b098b9c..e20ee4f4 100644 --- a/github.cabal +++ b/github.cabal @@ -155,25 +155,28 @@ library aeson >=1.4.0.0 && <1.5 , base-compat >=0.10.4 && <0.11 , base16-bytestring >=0.1.1.6 && <0.2 - , binary-orphans >=0.1.8.0 && <0.2 + , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 - , exceptions >=0.10.0 && <0.11 - , hashable >=1.2.7.0 && <1.3 + , exceptions >=0.10.2 && <0.11 + , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.7 , http-client-tls >=0.3.5.3 && <0.4 , http-link-header >=1.0.3.1 && <1.1 - , http-types >=0.12.1 && <0.13 + , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 - , semigroups >=0.18.5 && <0.20 , tagged , tls >=1.4.1 - , transformers-compat >=0.6 && <0.7 - , unordered-containers >=0.2.9.0 && <0.3 + , transformers-compat >=0.6.5 && <0.7 + , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 + if !impl(ghc >= 8.0) + build-depends: + semigroups >=0.18.5 && <0.20 + test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 0a227092..cf05c99a 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -42,7 +42,7 @@ import Data.Aeson withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) -import Data.Binary.Orphans () +import Data.Binary.Instances () import Data.Data (Data, Typeable) import Data.Foldable (toList) import Data.Hashable (Hashable (..)) From ca8e48c3bfb34bbaff5d8042bf36919d977a81cd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 14:04:28 +0300 Subject: [PATCH 156/309] Add allow-newers --- .travis.yml | 11 ++++++----- cabal.project | 6 ++++++ github.cabal | 2 +- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index 4e9eb83d..b5789f33 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,7 +4,7 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.3.20190327 +# version: 0.3.20190521 # language: c dist: xenial @@ -29,8 +29,8 @@ before_cache: - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - - compiler: ghc-8.6.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.3","cabal-install-2.4"]}} + - compiler: ghc-8.6.5 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} - compiler: ghc-8.4.3 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}} - compiler: ghc-8.2.2 @@ -86,6 +86,7 @@ install: echo "world-file: $CABALHOME/world" >> $CABALHOME/config echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config + echo "installdir: $CABALHOME/bin" >> $CABALHOME/config echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config echo "store-dir: $CABALHOME/store" >> $CABALHOME/config echo "install-dirs user" >> $CABALHOME/config @@ -102,7 +103,7 @@ install: echo 'packages: "."' >> cabal.project - | echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi @@ -126,7 +127,7 @@ script: echo 'packages: "github-*/*.cabal"' >> cabal.project - | echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building... diff --git a/cabal.project b/cabal.project index cf67e0cf..2f1a8084 100644 --- a/cabal.project +++ b/cabal.project @@ -4,3 +4,9 @@ packages: optimization: False tests: True + +constraints: hashable ^>=1.3 +constraints: semigroups ^>=0.19 + +allow-newer: aeson-1.4.3.0:hashable +allow-newer: aeson-1.4.3.0:semigroups diff --git a/github.cabal b/github.cabal index e20ee4f4..9559e30b 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.4 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 extra-source-files: README.md From 2f06754722577fe3498738d8fda6b6987dc364c6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 15:02:32 +0300 Subject: [PATCH 157/309] Add GHC-8.8 job --- .travis.yml | 17 +++++++++++++++++ github.cabal | 2 +- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index b5789f33..073d6a6d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,6 +29,9 @@ before_cache: - rm -rfv $CABALHOME/packages/head.hackage matrix: include: + - compiler: ghc-8.8.1 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} + env: GHCHEAD=true - compiler: ghc-8.6.5 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} - compiler: ghc-8.4.3 @@ -41,6 +44,8 @@ matrix: addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}} - compiler: ghc-7.8.4 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}} + allow_failures: + - compiler: ghc-8.8.1 before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - HCPKG="$HC-pkg" @@ -93,6 +98,18 @@ install: echo " prefix: $CABALHOME" >> $CABALHOME/config echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config + - | + if $GHCHEAD; then + echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config + + echo "repository head.hackage" >> $CABALHOME/config + echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config + echo " secure: True" >> $CABALHOME/config + echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config + echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config + echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config + echo " key-threshold: 3" >> $CABALHOME/config + fi - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v diff --git a/github.cabal b/github.cabal index 9559e30b..7219c048 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1 extra-source-files: README.md From d29358293c185d5a7fc3e51ab0ab9b03eda75612 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 15:35:09 +0300 Subject: [PATCH 158/309] Add WebhookRegistryPackageEvent --- src/GitHub/Data/Webhooks.hs | 99 +++++++++++++++++++------------------ 1 file changed, 51 insertions(+), 48 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index c2595fa8..cc778555 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -70,6 +70,7 @@ data RepoWebhookEvent | WebhookPullRequestReviewEvent | WebhookPullRequestReviewCommentEvent | WebhookPushEvent + | WebhookRegistryPackageEvent | WebhookReleaseEvent | WebhookRepositoryEvent | WebhookRepositoryImportEvent @@ -131,55 +132,56 @@ instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "check_run") = pure WebhookCheckRunEvent - parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "content_reference") = pure WebhookContentReferenceEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "download") = pure WebhookDownloadEvent - parseJSON (String "follow") = pure WebhookFollowEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "fork_apply") = pure WebhookForkApplyEvent - parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent - parseJSON (String "gist") = pure WebhookGistEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "installation") = pure WebhookInstallationEvent - parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "label") = pure WebhookLabelEvent - parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "membership") = pure WebhookMembershipEvent - parseJSON (String "meta") = pure WebhookMetaEvent - parseJSON (String "milestone") = pure WebhookMilestoneEvent - parseJSON (String "organization") = pure WebhookOrganizationEvent - parseJSON (String "org_block") = pure WebhookOrgBlockEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "project_card") = pure WebhookProjectCardEvent - parseJSON (String "project_column") = pure WebhookProjectColumnEvent - parseJSON (String "project") = pure WebhookProjectEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "repository") = pure WebhookRepositoryEvent - parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "check_run") = pure WebhookCheckRunEvent + parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "content_reference") = pure WebhookContentReferenceEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "download") = pure WebhookDownloadEvent + parseJSON (String "follow") = pure WebhookFollowEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "fork_apply") = pure WebhookForkApplyEvent + parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent + parseJSON (String "gist") = pure WebhookGistEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "installation") = pure WebhookInstallationEvent + parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "label") = pure WebhookLabelEvent + parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "membership") = pure WebhookMembershipEvent + parseJSON (String "meta") = pure WebhookMetaEvent + parseJSON (String "milestone") = pure WebhookMilestoneEvent + parseJSON (String "organization") = pure WebhookOrganizationEvent + parseJSON (String "org_block") = pure WebhookOrgBlockEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "ping") = pure WebhookPingEvent + parseJSON (String "project_card") = pure WebhookProjectCardEvent + parseJSON (String "project_column") = pure WebhookProjectColumnEvent + parseJSON (String "project") = pure WebhookProjectEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "registry_package") = pure WebhookRegistryPackageEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "repository") = pure WebhookRepositoryEvent + parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent parseJSON (String "repository_vulnerability_alert") = pure WebhookRepositoryVulnerabilityAlertEvent - parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent - parseJSON (String "star") = pure WebhookStarEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team") = pure WebhookTeamEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent + parseJSON (String "star") = pure WebhookStarEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team") = pure WebhookTeamEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where @@ -222,6 +224,7 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookPullRequestReviewEvent = String "pull_request_review" toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPushEvent = String "push" + toJSON WebhookRegistryPackageEvent = String "registry_package" toJSON WebhookReleaseEvent = String "release" toJSON WebhookRepositoryEvent = String "repository" toJSON WebhookRepositoryImportEvent = String "repository_import" From 899180c1043c604ec4eef87ea31336fb3778ab2e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 16:04:58 +0300 Subject: [PATCH 159/309] Add MtPreview media type: extension point --- github.cabal | 2 + spec/GitHub/PullRequestsSpec.hs | 105 ++++++++++++++++++++++++-------- src/GitHub/Data/Request.hs | 25 ++++---- src/GitHub/Request.hs | 42 +++++++++++-- 4 files changed, 129 insertions(+), 45 deletions(-) diff --git a/github.cabal b/github.cabal index 7219c048..a65a317d 100644 --- a/github.cabal +++ b/github.cabal @@ -206,6 +206,8 @@ test-suite github-test , bytestring , file-embed , github + , tagged + , text , hspec >=2.6.1 && <2.8 , unordered-containers , vector diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 0f08ab22..14cbee9a 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -1,21 +1,27 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where -import qualified GitHub +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 Data.Aeson + (FromJSON (..), eitherDecodeStrict, withObject, (.:)) +import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as LBS8 -import System.Environment (lookupEnv) +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) @@ -23,68 +29,75 @@ fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a -withAuth :: (GitHub.Auth -> IO ()) -> IO () +withAuth :: (GH.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GitHub.OAuth $ fromString token) + Just token -> action (GH.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do - cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts GitHub.FetchAll + cs <- GH.executeRequest auth $ + GH.pullRequestsForR owner repo opts GH.FetchAll cs `shouldSatisfy` isRight describe "pullRequestPatchR" $ it "works" $ withAuth $ \auth -> do - Right patch <- GitHub.executeRequest auth $ - GitHub.pullRequestPatchR "phadej" "github" (GitHub.IssueNumber 349) + Right patch <- GH.executeRequest auth $ + GH.pullRequestPatchR "phadej" "github" (GH.IssueNumber 349) head (LBS8.lines patch) `shouldBe` "From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001" describe "decoding pull request payloads" $ do it "decodes a pull request 'opened' payload" $ do - V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestOpened) `shouldBe` 0 - V.length (GitHub.pullRequestRequestedReviewers pullRequestOpened) + V.length (GH.pullRequestRequestedReviewers pullRequestOpened) `shouldBe` 0 it "decodes a pull request 'review_requested' payload" $ do - V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) `shouldBe` 1 - V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) + V.length (GH.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (GitHub.IssueNumber 14) + b <- GH.executeRequest auth $ GH.isPullRequestMergedR "phadej" "github" (GH.IssueNumber 14) b `shouldSatisfy` isRight fromRightS b `shouldBe` True + describe "Draft Pull Request" $ do + it "works" $ withAuth $ \auth -> do + cs <- GH.executeRequest auth $ + draftPullRequestsForR "phadej" "github" opts GH.FetchAll + + cs `shouldSatisfy` isRight + where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") ] - opts = GitHub.stateClosed + opts = GH.stateClosed - simplePullRequestOpened :: GitHub.SimplePullRequest + simplePullRequestOpened :: GH.SimplePullRequest simplePullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) - pullRequestOpened :: GitHub.PullRequest + pullRequestOpened :: GH.PullRequest pullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) - simplePullRequestReviewRequested :: GitHub.SimplePullRequest + simplePullRequestReviewRequested :: GH.SimplePullRequest simplePullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) - pullRequestReviewRequested :: GitHub.PullRequest + pullRequestReviewRequested :: GH.PullRequest pullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) @@ -93,3 +106,41 @@ spec = do prReviewRequestedPayload :: ByteString prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") + +------------------------------------------------------------------------------- +-- Draft Pull Requests +------------------------------------------------------------------------------- + +draftPullRequestsForR + :: GH.Name GH.Owner + -> GH.Name GH.Repo + -> GH.PullRequestMod + -> GH.FetchCount + -> GH.GenRequest ('GH.MtPreview ShadowCat) k (V.Vector DraftPR) +draftPullRequestsForR user repo opts = GH.PagedQuery + ["repos", GH.toPathPart user, GH.toPathPart repo, "pulls"] + (GH.prModToQueryString opts) + +data DraftPR = DraftPR + { dprId :: !(GH.Id GH.PullRequest) + , dprNumber :: !GH.IssueNumber + , dprTitle :: !Text + , dprDraft :: !Bool + } + deriving (Show) + +instance FromJSON DraftPR where + parseJSON = withObject "DraftPR" $ \obj -> DraftPR + <$> obj .: "id" + <*> obj .: "number" + <*> obj .: "title" + <*> obj .: "draft" + +-- | @application/vnd.github.shadow-cat-preview+json@ +data ShadowCat + +instance GH.PreviewAccept ShadowCat where + previewContentType = Tagged "application/vnd.github.shadow-cat-preview+json" + +instance FromJSON a => GH.PreviewParseResponse ShadowCat a where + previewParseResponse _ res = Tagged (GH.parseResponseJSON res) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 8fe08907..30f3bfbb 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -105,17 +105,18 @@ instance NFData FetchCount where rnf = genericRnf -- MediaType ------------------------------------------------------------------------------- -data MediaType - = 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 - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) +data MediaType a + = MtJSON -- ^ @application/vnd.github.v3+json@ + | MtRaw -- ^ @application/vnd.github.v3.raw@ + | MtDiff -- ^ @application/vnd.github.v3.diff@ + | MtPatch -- ^ @application/vnd.github.v3.patch@ + | MtSha -- ^ @application/vnd.github.v3.sha@ + | MtStar -- ^ @application/vnd.github.v3.star+json@ + | MtRedirect -- ^ + | MtStatus -- ^ Parse status + | MtUnit -- ^ Always succeeds + | MtPreview a -- ^ Some other (preview) type; this is an extension point. + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) ------------------------------------------------------------------------------ -- RW @@ -151,7 +152,7 @@ instance IReadOnly 'RA where iro = ROA -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. -data GenRequest (mt :: MediaType) (rw :: RW) a where +data GenRequest (mt :: MediaType *) (rw :: RW) a where Query :: Paths -> QueryString -> GenRequest mt rw a PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 4eb28fc7..10acad21 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -51,6 +51,10 @@ module GitHub.Request ( StatusMap, getNextUrl, performPagedRequest, + parseResponseJSON, + -- ** Preview + PreviewAccept (..), + PreviewParseResponse (..), ) where import GitHub.Internal.Prelude @@ -67,9 +71,9 @@ import Data.List (find) import Data.Tagged (Tagged (..)) import Network.HTTP.Client - (HttpException (..), Manager, RequestBody (..), Response (..), - applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount, - requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) + (HttpException (..), Manager, RequestBody (..), Response (..), getUri, + httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, + setQueryString, setRequestIgnoreStatus) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) @@ -179,15 +183,18 @@ unsafeDropAuthRequirements r = -- Parse response ------------------------------------------------------------------------------- -class Accept (mt :: MediaType) where +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) +class Accept mt => ParseResponse (mt :: MediaType *) a where + parseResponse + :: MonadError Error m + => HTTP.Request -> HTTP.Response LBS.ByteString + -> Tagged mt (m a) ------------------------------------------------------------------------------- -- JSON (+ star) @@ -258,6 +265,29 @@ parseRedirect originalUri rsp = do 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 ------------------------------------------------------------------------------- From ae57e5fa482a1bb687221ee67aa24db6b45bfef0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 17:56:35 +0300 Subject: [PATCH 160/309] Throw on non-200 responses --- src/GitHub/Request.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 10acad21..d1860dba 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -331,7 +331,9 @@ parseStatus m (Status sci _) = -- Unit ------------------------------------------------------------------------------- -instance Accept 'MtUnit +instance Accept 'MtUnit where + modifyRequest = Tagged setRequestIgnoreStatus + instance a ~ () => ParseResponse 'MtUnit a where parseResponse _ _ = Tagged (return ()) @@ -378,7 +380,7 @@ makeHttpRequest auth r = case r of $ req where parseUrl' :: MonadThrow m => Text -> m HTTP.Request - parseUrl' = HTTP.parseRequest . T.unpack + parseUrl' = HTTP.parseUrlThrow . T.unpack url :: Paths -> Text url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths From 7f4c8029a82ace5a3035ad0ff2c00b2990f72c63 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 17:57:27 +0300 Subject: [PATCH 161/309] Add changelog entry for 0.22 --- CHANGELOG.md | 17 +++++++++++++++++ github.cabal | 2 +- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index abc96133..8ee2e8da 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,22 @@ ## Changes for next +## Changes for 0.22 + + [#370](https://github.com/phadej/github/pull/370) +- Type-class for various auth methods + [#365](https://github.com/phadej/github/pull/365) +- Throw on non-200 responses + [#350](https://github.com/phadej/github/pull/350) +- Add extension point for (preview) media types +- Add missing webhook event types + [#359](https://github.com/phadej/github/pull/359) +- Update dependencies + [#364](https://github.com/phadej/github/pull/364) + [#368](https://github.com/phadej/github/pull/368) + [#369](https://github.com/phadej/github/pull/369) +- Documentation improvements + [#357](https://github.com/phadej/github/pull/357) + ## Changes for 0.21 - Refactor `Request` type. diff --git a/github.cabal b/github.cabal index a65a317d..8b9d422f 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.21 +version: 0.22 synopsis: Access to the GitHub API, v3. category: Network description: From 6d7b17628a04aacb9c9b69949d1661e83af74fbe Mon Sep 17 00:00:00 2001 From: Ivan Malison Date: Fri, 27 Apr 2018 02:37:13 -0700 Subject: [PATCH 162/309] Add notifications endpoint Fixes #323 --- github.cabal | 1 + src/GitHub/Data/Activities.hs | 84 ++++++++++++++++++- .../Endpoints/Activity/Notifications.hs | 39 +++++++++ src/GitHub/Internal/Prelude.hs | 3 +- 4 files changed, 125 insertions(+), 2 deletions(-) create mode 100644 src/GitHub/Endpoints/Activity/Notifications.hs diff --git a/github.cabal b/github.cabal index 8b9d422f..7b6724f1 100644 --- a/github.cabal +++ b/github.cabal @@ -101,6 +101,7 @@ library GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Starring + GitHub.Endpoints.Activity.Notifications GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 67896cb9..92c82b69 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -5,8 +5,11 @@ -- module GitHub.Data.Activities where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Id (Id, mkId) +import GitHub.Data.Repos (Repo, RepoRef) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude + import Prelude () data RepoStarred = RepoStarred @@ -24,3 +27,82 @@ instance FromJSON RepoStarred where <$> o .: "starred_at" <*> o .: "repo" +data Subject = Subject + { subjectTitle :: !Text + , subjectURL :: !URL + , subjectLatestCommentURL :: !(Maybe URL) + -- https://developer.github.com/v3/activity/notifications/ doesn't indicate + -- what the possible values for this field are. + -- TODO: Make an ADT for this. + , subjectType :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Subject where rnf = genericRnf +instance Binary Subject + +instance FromJSON Subject where + parseJSON = withObject "Subject" $ \o -> Subject + <$> o .: "title" + <*> o .: "url" + <*> o .:? "latest_comment_url" + <*> o .: "type" + +data NotificationReason + = AssignReason + | AuthorReason + | CommentReason + | InvitationReason + | ManualReason + | MentionReason + | ReviewRequestedReason + | StateChangeReason + | SubscribedReason + | TeamMentionReason + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData NotificationReason where rnf = genericRnf +instance Binary NotificationReason + +instance FromJSON NotificationReason where + parseJSON = withText "NotificationReason" $ \t -> case t of + "assign" -> pure AssignReason + "author" -> pure AuthorReason + "comment" -> pure CommentReason + "invitation" -> pure InvitationReason + "manual" -> pure ManualReason + "mention" -> pure MentionReason + "review_requested" -> pure ReviewRequestedReason + "state_change" -> pure StateChangeReason + "subscribed" -> pure SubscribedReason + "team_mention" -> pure TeamMentionReason + _ -> fail $ "Unknown NotificationReason " ++ show t + +data Notification = Notification + -- XXX: The notification id field type IS in fact string. Not sure why gh + -- chose to do this when all the other ids are Numbers... + { notificationId :: !(Id Notification) + , notificationRepo :: !RepoRef + , notificationSubject :: !Subject + , notificationReason :: !NotificationReason + , notificationUnread :: !Bool + , notificationUpdatedAt :: !(Maybe UTCTime) + , notificationLastReadAt :: !(Maybe UTCTime) + , notificationUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Notification where rnf = genericRnf +instance Binary Notification + +instance FromJSON Notification where + parseJSON = withObject "Notification" $ \o -> Notification + <$> (mkId undefined . read <$> o .: "id") + <*> o .: "repository" + <*> o .: "subject" + <*> o .: "reason" + <*> o .: "unread" + <*> o .: "updated_at" + <*> o .: "last_read_at" + <*> o .: "url" + diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs new file mode 100644 index 00000000..76792735 --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo watching API as described on +-- . + +module GitHub.Endpoints.Activity.Notifications where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +getNotifications :: Auth -> IO (Either Error (Vector Notification)) +getNotifications auth = + executeRequest auth $ getNotificationsR FetchAll + +getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) +getNotificationsR = + pagedQuery ["notifications"] [] + +markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) +markNotificationAsRead auth notificationId = + executeRequest auth $ markNotificationAsReadR notificationId + +markNotificationAsReadR :: Id Notification -> Request 'RW () +markNotificationAsReadR notificationId = SimpleQuery $ + Command Patch ["notifications", "threads", toPathPart notificationId] + (encode ()) + +markNotificationsAsRead :: Auth -> IO (Either Error ()) +markNotificationsAsRead auth = + executeRequest auth markAllNotificationsAsReadR + +markAllNotificationsAsReadR :: Request 'RW () +markAllNotificationsAsReadR = SimpleQuery $ + Command Put ["notifications"] $ encode emptyObject diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index cf05c99a..07a748b3 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -22,6 +22,7 @@ module GitHub.Internal.Prelude ( Semigroup(..), -- * Aeson FromJSON(..), ToJSON(..), Value(..), Object, + emptyObject, encode, withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, -- * Control.Applicative @@ -40,7 +41,7 @@ import Control.DeepSeq.Generics (genericRnf) import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (typeMismatch) +import Data.Aeson.Types (emptyObject, typeMismatch) import Data.Binary (Binary) import Data.Binary.Instances () import Data.Data (Data, Typeable) From 7020f6b28a7b043a3108831d944ab303c383fa37 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 18:11:14 +0300 Subject: [PATCH 163/309] Cleanup Notifications functionality --- CHANGELOG.md | 2 ++ src/GitHub.hs | 10 ++++++- .../Endpoints/Activity/Notifications.hs | 30 +++++++++++-------- 3 files changed, 29 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8ee2e8da..6b6554da 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,8 @@ - Add extension point for (preview) media types - Add missing webhook event types [#359](https://github.com/phadej/github/pull/359) +- Add notifications endpoints + [#324](https://github.com/phadej/github/pull/324) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) diff --git a/src/GitHub.hs b/src/GitHub.hs index 078a62f7..fb342a9c 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -16,9 +16,16 @@ module GitHub ( -- | See -- ** Events - -- | See https://developer.github.com/v3/activity/events/#events + -- | See repositoryEventsR, userEventsR, + + -- ** Notifications + -- | See + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + -- ** Starring -- | See -- @@ -374,6 +381,7 @@ module GitHub ( import GitHub.Data import GitHub.Endpoints.Activity.Events +import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs index 76792735..1561390c 100644 --- a/src/GitHub/Endpoints/Activity/Notifications.hs +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -15,25 +15,31 @@ import Prelude () getNotifications :: Auth -> IO (Either Error (Vector Notification)) getNotifications auth = - executeRequest auth $ getNotificationsR FetchAll + executeRequest auth $ getNotificationsR FetchAll +-- | List your notifications. +-- See getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) -getNotificationsR = - pagedQuery ["notifications"] [] +getNotificationsR = pagedQuery ["notifications"] [] markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) -markNotificationAsRead auth notificationId = - executeRequest auth $ markNotificationAsReadR notificationId +markNotificationAsRead auth nid = + executeRequest auth $ markNotificationAsReadR nid -markNotificationAsReadR :: Id Notification -> Request 'RW () -markNotificationAsReadR notificationId = SimpleQuery $ - Command Patch ["notifications", "threads", toPathPart notificationId] - (encode ()) +-- | Mark a thread as read. +-- See +markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW () +markNotificationAsReadR nid = Command + Patch + ["notifications", "threads", toPathPart nid] + (encode ()) markNotificationsAsRead :: Auth -> IO (Either Error ()) markNotificationsAsRead auth = executeRequest auth markAllNotificationsAsReadR -markAllNotificationsAsReadR :: Request 'RW () -markAllNotificationsAsReadR = SimpleQuery $ - Command Put ["notifications"] $ encode emptyObject +-- | Mark as read. +-- See +markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW () +markAllNotificationsAsReadR = + Command Put ["notifications"] $ encode emptyObject From be9464fd86c68211aead6064f8072a0a36e3ecc0 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Fri, 31 May 2019 01:58:55 +1000 Subject: [PATCH 164/309] Case insensitive enum parsing --- src/GitHub/Data/Content.hs | 15 ++--- src/GitHub/Data/Definitions.hs | 9 ++- src/GitHub/Data/Deployments.hs | 10 +-- src/GitHub/Data/Email.hs | 9 ++- src/GitHub/Data/Invitation.hs | 6 +- src/GitHub/Data/Issues.hs | 6 +- src/GitHub/Data/Options.hs | 22 ++++--- src/GitHub/Data/PullRequests.hs | 26 ++++---- src/GitHub/Data/Reviews.hs | 17 +++--- src/GitHub/Data/Statuses.hs | 12 ++-- src/GitHub/Data/Teams.hs | 40 ++++++------ src/GitHub/Data/Webhooks.hs | 104 ++++++++++++++++---------------- 12 files changed, 147 insertions(+), 129 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 81b44177..5461ffa0 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -6,13 +6,15 @@ -- module GitHub.Data.Content where -import Data.Aeson.Types (Pair) -import Data.Maybe (maybe) import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude import Prelude () +import Data.Aeson.Types (Pair) +import Data.Maybe (maybe) +import qualified Data.Text as T + data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) @@ -142,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: " ++ 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 -> diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index f440c48c..de7f4e54 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -134,11 +134,10 @@ 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 + _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where parseJSON = withObject "SimpleUser" $ \obj -> do diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index 8234d998..606d4077 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -27,8 +27,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Aeson as JSON -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text +import qualified Data.Text as T +import qualified Data.Text.Encoding as T data DeploymentQueryOption = DeploymentQuerySha !Text @@ -42,7 +42,7 @@ instance Binary DeploymentQueryOption renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) renderDeploymentQueryOption = - second Text.encodeUtf8 . \case + second T.encodeUtf8 . \case DeploymentQuerySha sha -> ("sha", sha) DeploymentQueryRef ref -> ("ref", ref) DeploymentQueryTask task -> ("task", task) @@ -172,13 +172,13 @@ instance ToJSON DeploymentStatusState where DeploymentStatusInactive -> "inactive" instance FromJSON DeploymentStatusState where - parseJSON = withText "GitHub DeploymentStatusState" $ \case + parseJSON = withText "DeploymentStatusState" $ \t -> case T.toLower t of "error" -> pure DeploymentStatusError "failure" -> pure DeploymentStatusFailure "pending" -> pure DeploymentStatusPending "success" -> pure DeploymentStatusSuccess "inactive" -> pure DeploymentStatusInactive - x -> fail $ "Unknown deployment status: " ++ Text.unpack x + _ -> fail $ "Unknown DeploymentStatusState: " <> T.unpack t data CreateDeploymentStatus = CreateDeploymentStatus { createDeploymentStatusState :: !DeploymentStatusState diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index 23f738c6..d27237e5 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -8,6 +8,8 @@ module GitHub.Data.Email where import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data EmailVisibility = EmailVisibilityPrivate | EmailVisibilityPublic @@ -17,9 +19,10 @@ instance NFData EmailVisibility where rnf = genericRnf instance Binary EmailVisibility instance FromJSON EmailVisibility where - parseJSON (String "private") = pure EmailVisibilityPrivate - parseJSON (String "public") = pure EmailVisibilityPublic - parseJSON _ = fail "Could not build an EmailVisibility" + parseJSON = withText "EmailVisibility" $ \t -> case T.toLower t of + "private" -> pure EmailVisibilityPrivate + "public" -> pure EmailVisibilityPublic + _ -> fail $ "Unknown EmailVisibility: " <> T.unpack t data Email = Email { emailAddress :: !Text diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index b4126ccc..07d4a99f 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -11,6 +11,8 @@ import GitHub.Data.Name (Name) 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` ? @@ -48,10 +50,10 @@ instance NFData InvitationRole where rnf = genericRnf instance Binary InvitationRole instance FromJSON InvitationRole where - parseJSON = withText "InvirationRole" $ \t -> case t of + parseJSON = withText "InvitationRole" $ \t -> case T.toLower t of "direct_member" -> pure InvitationRoleDirectMember "admin" -> pure InvitationRoleAdmin "billing_manager" -> pure InvitationRoleBillingManager "hiring_manager" -> pure InvitationRoleHiringManager "reinstate" -> pure InvitationRoleReinstate - _ -> fail $ "Invalid role " ++ show t + _ -> fail $ "Unknown InvitationRole: " <> T.unpack t diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 1775aeec..6e98da8f 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -15,6 +15,8 @@ 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 @@ -141,7 +143,7 @@ instance FromJSON IssueEvent where <*> o .:? "label" instance FromJSON EventType where - parseJSON = withText "EventType" $ \t -> case t of + parseJSON = withText "EventType" $ \t -> case T.toLower t of "closed" -> pure Closed "reopened" -> pure Reopened "subscribed" -> pure Subscribed @@ -169,7 +171,7 @@ instance FromJSON EventType where "removed_from_project" -> pure RemovedFromProject "converted_note_to_issue" -> pure ConvertedNoteToIssue "unsubscribed" -> pure Unsubscribed -- not in api docs list - _ -> fail $ "Unknown EventType " ++ show t + _ -> fail $ "Unknown EventType: " <> T.unpack t instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 84105277..9ef2be6a 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -82,9 +82,10 @@ instance ToJSON IssueState where toJSON StateClosed = String "closed" instance FromJSON IssueState where - parseJSON (String "open") = pure StateOpen - parseJSON (String "closed") = pure StateClosed - parseJSON v = typeMismatch "IssueState" v + parseJSON = withText "IssueState" $ \t -> case T.toLower t of + "open" -> pure StateOpen + "closed" -> pure StateClosed + _ -> fail $ "Unknown IssueState: " <> T.unpack t instance NFData IssueState where rnf = genericRnf instance Binary IssueState @@ -109,13 +110,14 @@ instance ToJSON MergeableState where toJSON StateBehind = String "behind" instance FromJSON MergeableState where - parseJSON (String "unknown") = pure StateUnknown - parseJSON (String "clean") = pure StateClean - parseJSON (String "dirty") = pure StateDirty - parseJSON (String "unstable") = pure StateUnstable - parseJSON (String "blocked") = pure StateBlocked - parseJSON (String "behind") = pure StateBehind - parseJSON v = typeMismatch "MergeableState" v + parseJSON = withText "MergeableState" $ \t -> case T.toLower t of + "unknown" -> pure StateUnknown + "clean" -> pure StateClean + "dirty" -> pure StateDirty + "unstable" -> pure StateUnstable + "blocked" -> pure StateBlocked + "behind" -> pure StateBehind + _ -> fail $ "Unknown MergeableState: " <> T.unpack t instance NFData MergeableState where rnf = genericRnf instance Binary MergeableState diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index b91311da..5c2f62e1 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -283,19 +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 (String "review_requested") = pure PullRequestReviewRequested - parseJSON (String "review_request_removed") = pure PullRequestReviewRequestRemoved - parseJSON (String "edited") = pure PullRequestEdited - parseJSON (String s) = fail $ "Unknown action type " <> T.unpack s - parseJSON v = typeMismatch "Could not build a PullRequestEventType" v + parseJSON = withText "PullRequestEventType" $ \t -> case T.toLower t of + "opened" -> pure PullRequestOpened + "closed" -> pure PullRequestClosed + "synchronize" -> pure PullRequestSynchronized + "reopened" -> pure PullRequestReopened + "assigned" -> pure PullRequestAssigned + "unassigned" -> pure PullRequestUnassigned + "labeled" -> pure PullRequestLabeled + "unlabeled" -> pure PullRequestUnlabeled + "review_requested" -> pure PullRequestReviewRequested + "review_request_removed" -> pure PullRequestReviewRequestRemoved + "edited" -> pure PullRequestEdited + _ -> fail $ "Unknown PullRequestEventType: " <> T.unpack t instance FromJSON PullRequestReference where parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 44405531..27278437 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -1,12 +1,14 @@ module GitHub.Data.Reviews where -import Data.Text (Text) import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import Data.Text (Text) +import qualified Data.Text as T + data ReviewState = ReviewStatePending | ReviewStateApproved @@ -21,12 +23,13 @@ instance NFData ReviewState where instance Binary ReviewState instance FromJSON ReviewState where - parseJSON (String "APPROVED") = pure ReviewStateApproved - parseJSON (String "PENDING") = pure ReviewStatePending - parseJSON (String "DISMISSED") = pure ReviewStateDismissed - parseJSON (String "COMMENTED") = pure ReviewStateCommented - parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested - parseJSON _ = fail "Unexpected ReviewState" + parseJSON = withText "ReviewState" $ \t -> case T.toLower t of + "approved" -> pure ReviewStateApproved + "pending" -> pure ReviewStatePending + "dismissed" -> pure ReviewStateDismissed + "commented" -> pure ReviewStateCommented + "changes_requested" -> pure ReviewStateChangesRequested + _ -> fail $ "Unknown ReviewState: " <> T.unpack t data Review = Review { reviewBody :: !Text diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index 0b5e3b37..09853b26 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -14,6 +14,7 @@ import Prelude () import GitHub.Data.GitData (Commit) import GitHub.Data.Repos (RepoRef) +import qualified Data.Text as T data StatusState = StatusPending @@ -26,11 +27,12 @@ instance NFData StatusState where rnf = genericRnf instance Binary StatusState instance FromJSON StatusState where - parseJSON (String "pending") = pure StatusPending - parseJSON (String "success") = pure StatusSuccess - parseJSON (String "error") = pure StatusError - parseJSON (String "failure") = pure StatusFailure - parseJSON _ = fail "Could not build a StatusState" + parseJSON = withText "StatusState" $ \t -> case T.toLower t of + "pending" -> pure StatusPending + "success" -> pure StatusSuccess + "error" -> pure StatusError + "failure" -> pure StatusFailure + _ -> fail $ "Unknown StatusState: " <> T.unpack t instance ToJSON StatusState where toJSON StatusPending = String "pending" diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 86ddfcfa..387318e0 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -17,6 +17,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data Privacy = PrivacyClosed | PrivacySecret @@ -200,42 +202,42 @@ instance ToJSON AddTeamRepoPermission where object [ "permission" .= permission ] instance FromJSON Role where - parseJSON = withText "Attribute" $ \attr -> case attr of - "maintainer" -> return RoleMaintainer - "member" -> return RoleMember - _ -> fail $ "Unknown Role: " ++ show attr + parseJSON = withText "Role" $ \t -> case T.toLower t of + "maintainer" -> pure RoleMaintainer + "member" -> pure RoleMember + _ -> fail $ "Unknown Role: " <> T.unpack t instance ToJSON Role where toJSON RoleMaintainer = String "maintainer" toJSON RoleMember = String "member" +instance FromJSON Permission where + parseJSON = withText "Permission" $ \t -> case T.toLower t of + "pull" -> pure PermissionPull + "push" -> pure PermissionPush + "admin" -> pure PermissionAdmin + _ -> fail $ "Unknown Permission: " <> T.unpack t + instance ToJSON Permission where toJSON PermissionPull = "pull" toJSON PermissionPush = "push" toJSON PermissionAdmin = "admin" -instance FromJSON Permission where - parseJSON = withText "Permission Attribute" $ \attr -> case attr of - "pull" -> return PermissionPull - "push" -> return PermissionPush - "admin" -> return PermissionAdmin - _ -> fail $ "Unknown Permission Attribute: " ++ show attr - instance FromJSON Privacy where - parseJSON = withText "Privacy Attribute" $ \attr -> case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail $ "Unknown Privacy Attribute: " ++ show attr + parseJSON = withText "Privacy" $ \t -> case T.toLower t of + "secret" -> pure PrivacySecret + "closed" -> pure PrivacyClosed + _ -> fail $ "Unknown Privacy: " <> T.unpack t instance ToJSON Privacy where toJSON PrivacySecret = String "secret" toJSON PrivacyClosed = String "closed" instance FromJSON ReqState where - parseJSON = withText "ReqState" $ \attr -> case attr of - "active" -> return StateActive - "pending" -> return StatePending - _ -> fail $ "Unknown ReqState: " ++ show attr + parseJSON = withText "ReqState" $ \t -> case T.toLower t of + "active" -> pure StateActive + "pending" -> pure StatePending + _ -> fail $ "Unknown ReqState: " <> T.unpack t instance ToJSON ReqState where toJSON StateActive = String "active" diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index cc778555..e58f8e69 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -11,6 +11,7 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.Map as M +import qualified Data.Text as T data RepoWebhook = RepoWebhook { repoWebhookUrl :: !URL @@ -132,57 +133,58 @@ instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "check_run") = pure WebhookCheckRunEvent - parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "content_reference") = pure WebhookContentReferenceEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "download") = pure WebhookDownloadEvent - parseJSON (String "follow") = pure WebhookFollowEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "fork_apply") = pure WebhookForkApplyEvent - parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent - parseJSON (String "gist") = pure WebhookGistEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "installation") = pure WebhookInstallationEvent - parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "label") = pure WebhookLabelEvent - parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "membership") = pure WebhookMembershipEvent - parseJSON (String "meta") = pure WebhookMetaEvent - parseJSON (String "milestone") = pure WebhookMilestoneEvent - parseJSON (String "organization") = pure WebhookOrganizationEvent - parseJSON (String "org_block") = pure WebhookOrgBlockEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "project_card") = pure WebhookProjectCardEvent - parseJSON (String "project_column") = pure WebhookProjectColumnEvent - parseJSON (String "project") = pure WebhookProjectEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "registry_package") = pure WebhookRegistryPackageEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "repository") = pure WebhookRepositoryEvent - parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent - parseJSON (String "repository_vulnerability_alert") = pure WebhookRepositoryVulnerabilityAlertEvent - parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent - parseJSON (String "star") = pure WebhookStarEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team") = pure WebhookTeamEvent - 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 + "commit_comment" -> pure WebhookCommitCommentEvent + "content_reference" -> pure WebhookContentReferenceEvent + "create" -> pure WebhookCreateEvent + "delete" -> pure WebhookDeleteEvent + "deploy_key" -> pure WebhookDeployKeyEvent + "deployment" -> pure WebhookDeploymentEvent + "deployment_status" -> pure WebhookDeploymentStatusEvent + "download" -> pure WebhookDownloadEvent + "follow" -> pure WebhookFollowEvent + "fork" -> pure WebhookForkEvent + "fork_apply" -> pure WebhookForkApplyEvent + "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent + "gist" -> pure WebhookGistEvent + "gollum" -> pure WebhookGollumEvent + "installation" -> pure WebhookInstallationEvent + "installation_repositories" -> pure WebhookInstallationRepositoriesEvent + "issue_comment" -> pure WebhookIssueCommentEvent + "issues" -> pure WebhookIssuesEvent + "label" -> pure WebhookLabelEvent + "marketplace_purchase" -> pure WebhookMarketplacePurchaseEvent + "member" -> pure WebhookMemberEvent + "membership" -> pure WebhookMembershipEvent + "meta" -> pure WebhookMetaEvent + "milestone" -> pure WebhookMilestoneEvent + "organization" -> pure WebhookOrganizationEvent + "org_block" -> pure WebhookOrgBlockEvent + "page_build" -> pure WebhookPageBuildEvent + "ping" -> pure WebhookPingEvent + "project_card" -> pure WebhookProjectCardEvent + "project_column" -> pure WebhookProjectColumnEvent + "project" -> pure WebhookProjectEvent + "public" -> pure WebhookPublicEvent + "pull_request" -> pure WebhookPullRequestEvent + "pull_request_review" -> pure WebhookPullRequestReviewEvent + "pull_request_review_comment" -> pure WebhookPullRequestReviewCommentEvent + "push" -> pure WebhookPushEvent + "registry_package" -> pure WebhookRegistryPackageEvent + "release" -> pure WebhookReleaseEvent + "repository" -> pure WebhookRepositoryEvent + "repository_import" -> pure WebhookRepositoryImportEvent + "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent + "security_advisory" -> pure WebhookSecurityAdvisoryEvent + "star" -> pure WebhookStarEvent + "status" -> pure WebhookStatusEvent + "team" -> pure WebhookTeamEvent + "team_add" -> pure WebhookTeamAddEvent + "watch" -> pure WebhookWatchEvent + _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" From 3b7048a34a671c8aa7b0bc6fafd45cfddc669534 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 20:58:24 +0300 Subject: [PATCH 165/309] Squashed commit of the following: commit 267979d510cc01fb38ac3428d4168327392f4d4b Author: Sajid Ibne Anower Date: Thu May 2 13:16:38 2019 +1000 Add function to list user's invitations ... and others --- github.cabal | 1 + src/GitHub.hs | 14 +++++++++ src/GitHub/Data/Invitation.hs | 28 +++++++++++++++++ src/GitHub/Data/Request.hs | 2 +- src/GitHub/Endpoints/Repos/Collaborators.hs | 4 +-- src/GitHub/Endpoints/Repos/Invitations.hs | 35 +++++++++++++++++++++ 6 files changed, 81 insertions(+), 3 deletions(-) create mode 100644 src/GitHub/Endpoints/Repos/Invitations.hs diff --git a/github.cabal b/github.cabal index 7b6724f1..5782b8e2 100644 --- a/github.cabal +++ b/github.cabal @@ -132,6 +132,7 @@ library GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks + GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails diff --git a/src/GitHub.hs b/src/GitHub.hs index fb342a9c..f847e45d 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -319,6 +319,19 @@ module GitHub ( latestReleaseR, releaseByTagNameR, + -- ** Invitations + -- | See + -- Missing endpoints: + + -- * Delete a repository invitation + -- * Update a repository invitation + -- * Decline a repository invitation + + listInvitationsOnR, + acceptInvitationFromR, + listInvitationsForR, + + -- * Search -- | See -- @@ -408,6 +421,7 @@ import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks +import GitHub.Endpoints.Repos.Invitations import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 07d4a99f..894ce64f 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -8,6 +8,8 @@ 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 () @@ -57,3 +59,29 @@ instance FromJSON InvitationRole where "hiring_manager" -> pure InvitationRoleHiringManager "reinstate" -> pure InvitationRoleReinstate _ -> fail $ "Unknown InvitationRole: " <> T.unpack t + +data RepoInvitation = RepoInvitation + { repoInvitationId :: !(Id RepoInvitation) + , repoInvitationInvitee :: !SimpleUser + , repoInvitationInviter :: !SimpleUser + , repoInvitationRepo :: !Repo + , repoInvitationUrl :: !URL + , repoInvitationCreatedAt :: !UTCTime + , repoInvitationPermission :: !Text + , repoInvitationHtmlUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoInvitation where rnf = genericRnf +instance Binary RepoInvitation + +instance FromJSON RepoInvitation where + parseJSON = withObject "RepoInvitation" $ \o -> RepoInvitation + <$> o .: "id" + <*> o .: "invitee" + <*> o .: "inviter" + <*> o .: "repository" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "permissions" + <*> o .: "html_url" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 30f3bfbb..04f38339 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -26,7 +26,7 @@ module GitHub.Data.Request ( Count, ) where -import GitHub.Data.Definitions (Count, QueryString, IssueNumber, unIssueNumber) +import GitHub.Data.Definitions (Count, IssueNumber, QueryString, unIssueNumber) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index bc441a28..ac0d9c0e 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -68,7 +68,7 @@ addCollaborator -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> IO (Either Error ()) + -> IO (Either Error (Maybe RepoInvitation)) addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll @@ -78,6 +78,6 @@ addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> GenRequest 'MtUnit 'RW () + -> 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/Invitations.hs b/src/GitHub/Endpoints/Repos/Invitations.hs new file mode 100644 index 00000000..68239961 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Invitations.hs @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo invitations API as described on +-- . +module GitHub.Endpoints.Repos.Invitations ( + listInvitationsOnR, + listInvitationsForR, + acceptInvitationFromR + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List open invitations of a repository +-- See +listInvitationsOnR :: Name Owner -> Name Repo -> FetchCount -> GenRequest 'MtJSON k (Vector RepoInvitation) +listInvitationsOnR user repo = + PagedQuery ["repos", toPathPart user, toPathPart repo, "invitations"] [] + +-- | List a user's repository invitations +-- See +listInvitationsForR :: FetchCount -> Request k (Vector RepoInvitation) +listInvitationsForR = + pagedQuery ["user", "repository_invitations"] [] + + +-- | Accept a repository invitation +-- See +acceptInvitationFromR :: Id RepoInvitation -> GenRequest 'MtUnit 'RW () +acceptInvitationFromR invId = + Command Patch ["user", "repository_invitations", toPathPart invId] mempty From 0bbfa922fd82fa97e3d4fee86d8c4f0db1c4d7bd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 21:03:09 +0300 Subject: [PATCH 166/309] case-insensitive parsing of NotificationReason --- CHANGELOG.md | 6 +++++- src/GitHub/Data/Activities.hs | 24 +++++++++++++----------- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b6554da..46c0caf7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,16 +2,20 @@ ## Changes for 0.22 - [#370](https://github.com/phadej/github/pull/370) - Type-class for various auth methods [#365](https://github.com/phadej/github/pull/365) - Throw on non-200 responses [#350](https://github.com/phadej/github/pull/350) - Add extension point for (preview) media types + [#370](https://github.com/phadej/github/pull/370) - Add missing webhook event types [#359](https://github.com/phadej/github/pull/359) +- Add invitation endpoint + [#360](https://github.com/phadej/github/pull/360) - Add notifications endpoints [#324](https://github.com/phadej/github/pull/324) +- Case insensitive enum parsing + [#373](https://github.com/phadej/github/pull/373) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 92c82b69..d95d3a25 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -12,6 +12,8 @@ import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime , repoStarredRepo :: !Repo @@ -65,18 +67,18 @@ instance NFData NotificationReason where rnf = genericRnf instance Binary NotificationReason instance FromJSON NotificationReason where - parseJSON = withText "NotificationReason" $ \t -> case t of - "assign" -> pure AssignReason - "author" -> pure AuthorReason - "comment" -> pure CommentReason - "invitation" -> pure InvitationReason - "manual" -> pure ManualReason - "mention" -> pure MentionReason + parseJSON = withText "NotificationReason" $ \t -> case T.toLower t of + "assign" -> pure AssignReason + "author" -> pure AuthorReason + "comment" -> pure CommentReason + "invitation" -> pure InvitationReason + "manual" -> pure ManualReason + "mention" -> pure MentionReason "review_requested" -> pure ReviewRequestedReason - "state_change" -> pure StateChangeReason - "subscribed" -> pure SubscribedReason - "team_mention" -> pure TeamMentionReason - _ -> fail $ "Unknown NotificationReason " ++ show t + "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 From ec65aaea90c10b08fc84719fda9adf91a07eee38 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 21:13:28 +0300 Subject: [PATCH 167/309] GHC-8.4.3 -> GHC-8.4.4 on travis --- .travis.yml | 4 ++-- github.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 073d6a6d..f041988c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -34,8 +34,8 @@ matrix: env: GHCHEAD=true - compiler: ghc-8.6.5 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} - - compiler: ghc-8.4.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}} + - compiler: ghc-8.4.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}} - compiler: ghc-8.2.2 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}} - compiler: ghc-8.0.2 diff --git a/github.cabal b/github.cabal index 5782b8e2..d09f3eb7 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 extra-source-files: README.md From 8b31817300eef27c26bdadb66b2c9b420c17d81b Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Thu, 9 May 2019 21:06:00 +0000 Subject: [PATCH 168/309] Implement interface to GitHub's SSH public key API --- github.cabal | 3 + spec/GitHub/PublicSSHKeysSpec.hs | 43 +++++++++++ src/GitHub/Data.hs | 2 + src/GitHub/Data/PublicSSHKeys.hs | 60 +++++++++++++++ src/GitHub/Endpoints/Users/PublicSSHKeys.hs | 83 +++++++++++++++++++++ 5 files changed, 191 insertions(+) create mode 100644 spec/GitHub/PublicSSHKeysSpec.hs create mode 100644 src/GitHub/Data/PublicSSHKeys.hs create mode 100644 src/GitHub/Endpoints/Users/PublicSSHKeys.hs diff --git a/github.cabal b/github.cabal index d09f3eb7..4380742d 100644 --- a/github.cabal +++ b/github.cabal @@ -87,6 +87,7 @@ library GitHub.Data.Milestone GitHub.Data.Name GitHub.Data.Options + GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests GitHub.Data.RateLimit GitHub.Data.Releases @@ -137,6 +138,7 @@ library GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers + GitHub.Endpoints.Users.PublicSSHKeys GitHub.Internal.Prelude GitHub.Request @@ -194,6 +196,7 @@ test-suite github-test GitHub.IssuesSpec GitHub.OrganizationsSpec GitHub.PullRequestReviewsSpec + GitHub.PublicSSHKeysSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs new file mode 100644 index 00000000..8d84b7b6 --- /dev/null +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.PublicSSHKeysSpec where + +import GitHub (Auth (..), PublicSSHKeyBasic (..), PublicSSHKey (..), + executeRequest, repositoryR) +import GitHub.Endpoints.Users.PublicSSHKeys (publicSSHKeysFor', publicSSHKeys', + publicSSHKey') + +import Data.Either.Compat (isRight) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) + +import qualified Data.HashMap.Strict as HM +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" $ do + keys <- publicSSHKeysFor' "phadej" + V.length (fromRightS keys) `shouldSatisfy` (> 1) + + describe "publicSSHKeys' and publicSSHKey'" $ do + it "works" $ withAuth $ \auth -> do + keys <- publicSSHKeys' auth + V.length (fromRightS keys) `shouldSatisfy` (> 1) + + key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys)) + key `shouldSatisfy` isRight diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index e6fbd4a0..6acc0bf2 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -48,6 +48,7 @@ module GitHub.Data ( 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, @@ -81,6 +82,7 @@ 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 diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs new file mode 100644 index 00000000..4a469917 --- /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, Typeable, Eq, Ord, Generic) + +instance FromJSON PublicSSHKeyBasic where + parseJSON = withObject "PublicSSHKeyBasic" $ \o -> PublicSSHKeyBasic + <$> o .: "id" + <*> o .: "key" + +data PublicSSHKey = PublicSSHKey + { publicSSHKeyId :: !(Id PublicSSHKey) + , publicSSHKeyKey :: !Text + , publicSSHKeyUrl :: !URL + , publicSSHKeyTitle :: !Text + , publicSSHKeyVerified :: !Bool + , publicSSHKeyCreatedAt :: !UTCTime + , publicSSHKeyReadOnly :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON PublicSSHKey where + parseJSON = withObject "PublicSSHKey" $ \o -> PublicSSHKey + <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" + +data NewPublicSSHKey = NewPublicSSHKey + { newPublicSSHKeyKey :: !Text + , newPublicSSHKeyTitle :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance ToJSON NewPublicSSHKey where + toJSON (NewPublicSSHKey key title) = object + [ "key" .= key + , "title" .= title + ] + +instance FromJSON NewPublicSSHKey where + parseJSON = withObject "PublicSSHKey" $ \o -> NewPublicSSHKey + <$> o .: "key" + <*> o .: "title" diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs new file mode 100644 index 00000000..b55b8bbc --- /dev/null +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -0,0 +1,83 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +-- The public keys API, as described at +-- +module GitHub.Endpoints.Users.PublicSSHKeys ( + -- * Querying public SSH keys + publicSSHKeys', + publicSSHKeysR, + publicSSHKeysFor', + publicSSHKeysForR, + publicSSHKey', + publicSSHKeyR, + + -- ** Create + createUserPublicSSHKey', + createUserPublicSSHKeyR, + + -- ** Delete + deleteUserPublicSSHKey', + deleteUserPublicSSHKeyR, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | Querying public SSH keys. +publicSSHKeysFor' :: Name Owner -> IO (Either Error (Vector PublicSSHKeyBasic)) +publicSSHKeysFor' user = + executeRequest' $ publicSSHKeysForR user FetchAll + +-- | Querying public SSH keys. +-- See +publicSSHKeysForR :: Name Owner -> FetchCount -> Request 'RO (Vector PublicSSHKeyBasic) +publicSSHKeysForR user = + pagedQuery ["users", toPathPart user, "keys"] [] + +-- | Querying the authenticated users' public SSH keys +publicSSHKeys' :: Auth -> IO (Either Error (Vector PublicSSHKey)) +publicSSHKeys' auth = + executeRequest auth publicSSHKeysR + +-- | Querying the authenticated users' public SSH keys +-- See +publicSSHKeysR :: Request 'RA (Vector PublicSSHKey) +publicSSHKeysR = + query ["user", "keys"] [] + +-- | Querying a public SSH key +publicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error PublicSSHKey) +publicSSHKey' auth keyId = + executeRequest auth $ publicSSHKeyR keyId + +-- | Querying a public SSH key. +-- See +publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey +publicSSHKeyR keyId = + query ["user", "keys", toPathPart keyId] [] + +-- | Create a public SSH key +createUserPublicSSHKey' :: Auth -> NewPublicSSHKey -> IO (Either Error PublicSSHKey) +createUserPublicSSHKey' auth key = + executeRequest auth $ createUserPublicSSHKeyR key + +-- | Create a public SSH key. +-- See . +createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey +createUserPublicSSHKeyR key = + command Post ["user", "keys"] (encode key) + +deleteUserPublicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error ()) +deleteUserPublicSSHKey' auth keyId = + executeRequest auth $ deleteUserPublicSSHKeyR keyId + +-- | Delete a public SSH key. +-- See +deleteUserPublicSSHKeyR :: Id PublicSSHKey -> Request 'RW () +deleteUserPublicSSHKeyR keyId = + command Delete ["user", "keys", toPathPart keyId] mempty From 6f916af176f2f4ce5aa355e6934e78899ce9fb1b Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Thu, 9 May 2019 21:06:31 +0000 Subject: [PATCH 169/309] Add SSH public key API samples --- .../Users/PublicSSHKeys/CreatePublicSSHKey.hs | 22 ++++++++ .../Users/PublicSSHKeys/DeletePublicSSHKey.hs | 14 +++++ .../Users/PublicSSHKeys/ListPublicSSHKeys.hs | 24 +++++++++ .../Users/PublicSSHKeys/ShowPublicSSHKey.hs | 15 ++++++ samples/github-samples.cabal | 53 +++++++++++++++++++ 5 files changed, 128 insertions(+) create mode 100644 samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs create mode 100644 samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs create mode 100644 samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs create mode 100644 samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs diff --git a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs new file mode 100644 index 00000000..e8cd6874 --- /dev/null +++ b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs @@ -0,0 +1,22 @@ +{-# 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 +import Data.Text (Text) + +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) -> putStrLn $ show 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..645390f4 --- /dev/null +++ b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs @@ -0,0 +1,24 @@ +{-# 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 +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..f9fe4829 --- /dev/null +++ b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +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.publicSSHKey' auth (Id 18528451) + case ePublicSSHKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKey) -> putStrLn $ show publicSSHKey diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 830c1e37..4595e3dd 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -269,3 +269,56 @@ executable github-teaminfo-for , text , github-samples default-language: Haskell2010 + +executable github-create-public-ssh-key + main-is: CreatePublicSSHKey.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + default-language: Haskell2010 + +executable github-delete-public-ssh-key + main-is: DeletePublicSSHKey.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + default-language: Haskell2010 + +executable github-list-public-ssh-keys + main-is: ListPublicSSHKeys.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , vector + default-language: Haskell2010 + +executable github-get-public-ssh-key + main-is: ShowPublicSSHKey.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + default-language: Haskell2010 From e870a84ea439fa4664614533c06b343e4a74d3f0 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Thu, 16 May 2019 20:01:04 +0000 Subject: [PATCH 170/309] Allow created_at field to be null --- src/GitHub/Data/PublicSSHKeys.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs index 4a469917..125cd4aa 100644 --- a/src/GitHub/Data/PublicSSHKeys.hs +++ b/src/GitHub/Data/PublicSSHKeys.hs @@ -27,7 +27,7 @@ data PublicSSHKey = PublicSSHKey , publicSSHKeyUrl :: !URL , publicSSHKeyTitle :: !Text , publicSSHKeyVerified :: !Bool - , publicSSHKeyCreatedAt :: !UTCTime + , publicSSHKeyCreatedAt :: !(Maybe UTCTime) , publicSSHKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -39,7 +39,7 @@ instance FromJSON PublicSSHKey where <*> o .: "url" <*> o .: "title" <*> o .: "verified" - <*> o .: "created_at" + <*> o .:? "created_at" <*> o .: "read_only" data NewPublicSSHKey = NewPublicSSHKey From 277f9b6c8080d91b7c6e11c0246c41c46e8a17bf Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 21:16:36 +0300 Subject: [PATCH 171/309] Add changelog note --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 46c0caf7..83bc1305 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,8 @@ [#360](https://github.com/phadej/github/pull/360) - Add notifications endpoints [#324](https://github.com/phadej/github/pull/324) +- Add ssh keys endpoints + [#363](https://github.com/phadej/github/pull/365) - Case insensitive enum parsing [#373](https://github.com/phadej/github/pull/373) - Update dependencies From 33b093c565a7fe27db30671c0f190344411b500d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 31 May 2019 01:05:28 +0300 Subject: [PATCH 172/309] CI runs out of API rate limit + Other cleanup --- spec/GitHub/PublicSSHKeysSpec.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs index 8d84b7b6..b797c959 100644 --- a/spec/GitHub/PublicSSHKeysSpec.hs +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -2,18 +2,16 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.PublicSSHKeysSpec where -import GitHub (Auth (..), PublicSSHKeyBasic (..), PublicSSHKey (..), - executeRequest, repositoryR) -import GitHub.Endpoints.Users.PublicSSHKeys (publicSSHKeysFor', publicSSHKeys', - publicSSHKey') +import GitHub + (Auth (..), FetchCount (..), PublicSSHKey (..), executeRequest) +import GitHub.Endpoints.Users.PublicSSHKeys + (publicSSHKey', publicSSHKeys', publicSSHKeysForR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) -import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b @@ -30,8 +28,8 @@ withAuth action = do spec :: Spec spec = do describe "publicSSHKeysFor'" $ do - it "works" $ do - keys <- publicSSHKeysFor' "phadej" + it "works" $ withAuth $ \auth -> do + keys <- executeRequest auth $ publicSSHKeysForR "phadej" FetchAll V.length (fromRightS keys) `shouldSatisfy` (> 1) describe "publicSSHKeys' and publicSSHKey'" $ do From 0247582839ce23b22acdc07bb1a52b6dc98c9a39 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 31 May 2019 11:15:56 +0300 Subject: [PATCH 173/309] Use 'MtUnit in Commands returning () --- CHANGELOG.md | 2 ++ src/GitHub/Endpoints/Activity/Starring.hs | 4 ++-- src/GitHub/Endpoints/Gists.hs | 8 ++++---- src/GitHub/Endpoints/Issues/Comments.hs | 4 ++-- src/GitHub/Endpoints/Issues/Labels.hs | 12 ++++++------ src/GitHub/Endpoints/Issues/Milestones.hs | 4 ++-- src/GitHub/Endpoints/Organizations/Teams.hs | 8 ++++---- src/GitHub/Endpoints/Repos.hs | 6 ++++-- src/GitHub/Endpoints/Repos/Contents.hs | 4 ++-- src/GitHub/Endpoints/Repos/DeployKeys.hs | 4 ++-- src/GitHub/Endpoints/Repos/Webhooks.hs | 4 ++-- src/GitHub/Endpoints/Users/PublicSSHKeys.hs | 4 ++-- src/GitHub/Request.hs | 4 +++- 13 files changed, 37 insertions(+), 31 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 83bc1305..0b637c8e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,8 @@ [#363](https://github.com/phadej/github/pull/365) - Case insensitive enum parsing [#373](https://github.com/phadej/github/pull/373) +- Don't try parse unitary responses + [#377](https://github.com/phadej/github/issues/377) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 71558324..4eccfc5b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -91,7 +91,7 @@ unstarRepo auth user repo = executeRequest auth $ unstarRepoR user repo -- | Unstar a repo by the authenticated user. -- See -unstarRepoR :: Name Owner -> Name Repo -> Request 'RW () -unstarRepoR user repo = command Delete paths mempty +unstarRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +unstarRepoR user repo = Command Delete paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index c59ba5c5..773e7f17 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -81,8 +81,8 @@ unstarGist auth gid = executeRequest auth $ unstarGistR gid -- | Unstar a gist by the authenticated user. -- See -unstarGistR :: Name Gist -> Request 'RW () -unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty +unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty -- | Delete a gist by the authenticated user. -- @@ -92,5 +92,5 @@ deleteGist auth gid = executeRequest auth $ deleteGistR gid -- | Delete a gist by the authenticated user. -- See -deleteGistR :: Name Gist -> Request 'RW () -deleteGistR gid = command Delete ["gists", toPathPart gid] mempty +deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +deleteGistR gid = Command Delete ["gists", toPathPart gid] mempty diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 83f67024..0968022b 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -101,8 +101,8 @@ deleteComment auth user repo commid = -- | Delete a comment. -- See -deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> Request 'RW () +deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () deleteCommentR user repo commid = - command Delete parts mempty + Command Delete parts mempty where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 6fa03ed3..81affd8a 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -130,9 +130,9 @@ deleteLabel auth user repo lbl = -- | Delete a label. -- See -deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () +deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> GenRequest 'MtUnit 'RW () deleteLabelR user repo lbl = - command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- @@ -188,9 +188,9 @@ removeLabelFromIssue auth user repo iid lbl = -- | Remove a label from an issue. -- See -removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'RW () +removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () removeLabelFromIssueR user repo iid lbl = - command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty + 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. -- @@ -229,9 +229,9 @@ removeAllLabelsFromIssue auth user repo iid = -- | Remove all labels from an issue. -- See -removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'RW () +removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () removeAllLabelsFromIssueR user repo iid = - command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 282de6c9..574d2a0e 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -80,7 +80,7 @@ deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user -- | Delete a milestone. -- See -deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request 'RW () +deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> GenRequest 'MtUnit 'RW () deleteMilestoneR user repo mid = - command Delete + Command Delete ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] mempty diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 586d1f99..3aa19401 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -124,9 +124,9 @@ deleteTeam' auth tid = -- | Delete team. -- -- See -deleteTeamR :: Id Team -> Request 'RW () +deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () deleteTeamR tid = - command Delete ["teams", toPathPart tid] mempty + Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- @@ -214,9 +214,9 @@ deleteTeamMembershipFor' auth tid user = -- | Remove team membership. -- See -deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'RW () +deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () deleteTeamMembershipForR tid user = - command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty + Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 0c1cd83f..921204d5 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -330,6 +330,8 @@ deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo -deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () +-- | Delete a repository,. +-- See +deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () deleteRepoR user repo = - command Delete ["repos", toPathPart user, toPathPart repo] mempty + Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index b1e05ebe..bc5a9ab6 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -166,6 +166,6 @@ deleteFileR :: Name Owner -> Name Repo -> DeleteFile - -> Request 'RW () + -> GenRequest 'MtUnit 'RW () deleteFileR user repo body = - command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) + Command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 90b87703..f1080680 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -65,6 +65,6 @@ deleteRepoDeployKey' auth user repo keyId = -- | Delete a deploy key. -- See -deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> GenRequest 'MtUnit 'RW () deleteRepoDeployKeyR user repo keyId = - command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 34619c17..87e37fba 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -103,9 +103,9 @@ deleteRepoWebhook' auth user repo hookId = -- | Delete a hook. -- See -deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () deleteRepoWebhookR user repo hookId = - command Delete (createWebhookOpPath user repo hookId Nothing) mempty + Command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs index b55b8bbc..0eb9a4ee 100644 --- a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -78,6 +78,6 @@ deleteUserPublicSSHKey' auth keyId = -- | Delete a public SSH key. -- See -deleteUserPublicSSHKeyR :: Id PublicSSHKey -> Request 'RW () +deleteUserPublicSSHKeyR :: Id PublicSSHKey -> GenRequest 'MtUnit 'RW () deleteUserPublicSSHKeyR keyId = - command Delete ["user", "keys", toPathPart keyId] mempty + Command Delete ["user", "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index d1860dba..4da807f0 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -331,8 +331,10 @@ parseStatus m (Status sci _) = -- Unit ------------------------------------------------------------------------------- +-- | Note: we don't ignore response status. +-- +-- We only accept any response body. instance Accept 'MtUnit where - modifyRequest = Tagged setRequestIgnoreStatus instance a ~ () => ParseResponse 'MtUnit a where parseResponse _ _ = Tagged (return ()) From 334d451b55c1b9925bd576faa26b8fc478759f77 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 31 May 2019 13:07:52 +0300 Subject: [PATCH 174/309] Add openssl flag --- cabal.project | 2 ++ github.cabal | 23 ++++++++++++++++++----- src/GitHub/Request.hs | 30 +++++++++++++++++++++++++++--- 3 files changed, 47 insertions(+), 8 deletions(-) diff --git a/cabal.project b/cabal.project index 2f1a8084..b74f6712 100644 --- a/cabal.project +++ b/cabal.project @@ -10,3 +10,5 @@ constraints: semigroups ^>=0.19 allow-newer: aeson-1.4.3.0:hashable allow-newer: aeson-1.4.3.0:semigroups + +constraints: github +openssl diff --git a/github.cabal b/github.cabal index 4380742d..e0be1ae2 100644 --- a/github.cabal +++ b/github.cabal @@ -47,6 +47,11 @@ source-repository head type: git location: git://github.com/phadej/github.git +flag openssl + description: "Use http-client-openssl" + manual: True + default: False + library default-language: Haskell2010 ghc-options: -Wall @@ -165,18 +170,26 @@ library , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.7 - , http-client-tls >=0.3.5.3 && <0.4 , http-link-header >=1.0.3.1 && <1.1 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 - , tagged - , tls >=1.4.1 + , tagged >=0.8.5 && <0.9 , transformers-compat >=0.6.5 && <0.7 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 + if flag(openssl) + build-depends: + http-client-openssl >=0.3.0.0 && <0.4 + , HsOpenSSL >=0.11.4.16 && <0.12 + , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + else + build-depends: + http-client-tls >=0.3.5.3 && <0.4 + , tls >=1.4.1 + if !impl(ghc >= 8.0) build-depends: semigroups >=0.18.5 && <0.20 @@ -186,8 +199,8 @@ test-suite github-test type: exitcode-stdio-1.0 hs-source-dirs: spec main-is: Spec.hs - ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.8 + ghc-options: -Wall -threaded + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.8 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 4da807f0..2ad73a30 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -74,7 +74,6 @@ import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), getUri, httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) -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, Status (..)) @@ -88,18 +87,43 @@ import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP +#ifdef MIN_VERSION_http_client_tls +import Network.HTTP.Client.TLS (tlsManagerSettings) +#else +import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) + +import qualified OpenSSL.Session as SSL +import qualified OpenSSL.X509.SystemStore as SSL +#endif + import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request +#ifdef MIN_VERSION_http_client_tls +withOpenSSL :: IO a -> IO a +withOpenSSL = id +#else +tlsManagerSettings :: HTTP.ManagerSettings +tlsManagerSettings = opensslManagerSettings $ do + ctx <- SSL.context + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 + SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1 + SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256" + SSL.contextLoadSystemCerts ctx + SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing + return ctx +#endif + -- | Execute 'Request' in 'IO' executeRequest :: (AuthMethod am, ParseResponse mt a) => am -> GenRequest mt rw a -> IO (Either Error a) -executeRequest auth req = do +executeRequest auth req = withOpenSSL $ withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req @@ -137,7 +161,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do -- | Like 'executeRequest' but without authentication. executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) -executeRequest' req = do +executeRequest' req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr' manager req From 7d06a0fc02460889fbfc57a5b4d721d647775fe5 Mon Sep 17 00:00:00 2001 From: Ivan Malison Date: Tue, 4 Jun 2019 21:20:21 -0700 Subject: [PATCH 175/309] Update nix files --- default.nix | 29 +++-------------------------- overlay.nix | 31 +++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 26 deletions(-) create mode 100644 overlay.nix diff --git a/default.nix b/default.nix index 4b04872b..e8e50a1b 100644 --- a/default.nix +++ b/default.nix @@ -1,26 +1,3 @@ -{ 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; -} +let + pkgs = import { overlays = [ (import ./overlay.nix) ]; }; +in pkgs.haskellPackages.callCabal2nix "github" ./. { } diff --git a/overlay.nix b/overlay.nix new file mode 100644 index 00000000..173f195e --- /dev/null +++ b/overlay.nix @@ -0,0 +1,31 @@ +_: pkgs: { + haskellPackages = pkgs.haskellPackages.override (old: { + overrides = pkgs.lib.composeExtensions (old.overrides or (_: _: {})) (self: super: { + unordered-containers = pkgs.haskell.lib.overrideCabal super.unordered-containers (_: { + version = "0.2.10.0"; + sha256 = "0wy5hfrs880hh8hvp648bl07ws777n3kkmczzdszr7papnyigwb5"; + }); + binary-instances = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.binary-instances (old: { + libraryHaskellDepends = old.libraryHaskellDepends ++ [ + self.binary-orphans_1_0_1 + ]; + broken = false; + })); + binary-orphans_1_0_1 = pkgs.haskell.lib.dontCheck super.binary-orphans_1_0_1; + github = pkgs.haskell.lib.overrideCabal super.github (old: { + version = "0.22"; + sha256 = "15py79qcpj0k331i42njgwkirwyiacbc5razmxnm4672dvvip2qk"; + libraryHaskellDepends = old.libraryHaskellDepends ++ [ + self.binary-instances self.exceptions self.transformers-compat + ]; + }); + time-compat = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.time-compat (old: { + version = "1.9.2.2"; + sha256 = "05va0rqs759vbridbcl6hksp967j9anjvys8vx72fnfkhlrn2s52"; + libraryHaskellDepends = old.libraryHaskellDepends ++ [ + self.base-orphans + ]; + })); + }); + }); +} From 00310c34a9cc2c2cd5523ae42288b68f7e200f93 Mon Sep 17 00:00:00 2001 From: Attila Domokos Date: Thu, 27 Jun 2019 01:05:29 -0500 Subject: [PATCH 176/309] Fix compile time warnings --- samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs | 5 ++--- samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs | 1 - samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs | 1 - 3 files changed, 2 insertions(+), 5 deletions(-) diff --git a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs index e8cd6874..7ccdf478 100644 --- a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs +++ b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs @@ -4,15 +4,14 @@ 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 -import Data.Text (Text) 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) -> putStrLn $ show publicSSHKey + Left err -> putStrLn $ "Error: " ++ show err + Right publicSSHKey -> print publicSSHKey newPublicSSHKey :: PK.NewPublicSSHKey newPublicSSHKey = diff --git a/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs index 645390f4..2a485127 100644 --- a/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs +++ b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs @@ -1,7 +1,6 @@ {-# 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 import Data.List (intercalate) diff --git a/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs index f9fe4829..249a3728 100644 --- a/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs +++ b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs @@ -2,7 +2,6 @@ module Main (main) where import GitHub.Data.Id (Id (..)) -import qualified GitHub.Data.PublicSSHKeys as PK import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK import qualified GitHub.Auth as Auth From e850e83b104abfefb1fbd0f1317f973252029b90 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 12 Sep 2019 12:11:10 +0300 Subject: [PATCH 177/309] Support ghc-8.8.1 --- .travis.yml | 86 ++++--- cabal.haskell-ci | 2 + cabal.project | 8 +- github.cabal | 42 ++-- samples/LICENSE | 1 + samples/Users/Followers/Example.hs | 2 +- samples/github-samples.cabal | 390 +++++++++-------------------- src/GitHub/Data/Deployments.hs | 5 +- 8 files changed, 197 insertions(+), 339 deletions(-) create mode 100644 cabal.haskell-ci create mode 120000 samples/LICENSE diff --git a/.travis.yml b/.travis.yml index f041988c..594e2d55 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,10 +1,10 @@ # This Travis job script has been generated by a script via # -# haskell-ci '--branches' 'master' '-o' '.travis.yml' 'github.cabal' +# haskell-ci '--config=cabal.haskell-ci' 'cabal.project' # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.3.20190521 +# version: 0.5.20190908 # language: c dist: xenial @@ -31,30 +31,29 @@ matrix: include: - compiler: ghc-8.8.1 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} - env: GHCHEAD=true - compiler: ghc-8.6.5 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} - compiler: ghc-8.4.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} - compiler: ghc-8.2.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} - compiler: ghc-8.0.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} - compiler: ghc-7.10.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} - compiler: ghc-7.8.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}} - allow_failures: - - compiler: ghc-8.8.1 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') + - WITHCOMPILER="-w $HC" + - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - HCPKG="$HC-pkg" - unset CC - CABAL=/opt/ghc/bin/cabal - CABALHOME=$HOME/.cabal - export PATH="$CABALHOME/bin:$PATH" - TOP=$(pwd) - - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - CABAL="$CABAL -vnormal+nowrap+markoutput" - set -o pipefail @@ -81,11 +80,12 @@ install: - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks - - GHCHEAD=${GHCHEAD-false} + - HEADHACKAGE=false - rm -f $CABALHOME/config - | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config echo "remote-build-reporting: anonymous" >> $CABALHOME/config + echo "write-ghc-environment-files: always" >> $CABALHOME/config echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config echo "world-file: $CABALHOME/world" >> $CABALHOME/config @@ -99,17 +99,8 @@ install: echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config - | - if $GHCHEAD; then - echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config - - echo "repository head.hackage" >> $CABALHOME/config - echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config - echo " secure: True" >> $CABALHOME/config - echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config - echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config - echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config - echo " key-threshold: 3" >> $CABALHOME/config - fi + echo "program-default-options" >> $CABALHOME/config + echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v @@ -117,18 +108,23 @@ install: - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - | - echo 'packages: "."' >> cabal.project + echo "packages: ." >> cabal.project + echo "packages: samples" >> cabal.project - | - echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "optimization: False" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output + - if [ -f "samples/configure.ac" ]; then (cd "samples" && autoreconf -i); fi + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze - - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output - - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... @@ -136,32 +132,40 @@ script: # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; + - PKGDIR_github="$(find . -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" + - PKGDIR_github_samples="$(find . -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - | - echo 'packages: "github-*/*.cabal"' >> cabal.project + echo "packages: ${PKGDIR_github}" >> cabal.project + echo "packages: ${PKGDIR_github_samples}" >> cabal.project - | - echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "optimization: False" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building... # this builds all libraries and executables (without tests/benchmarks) - - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output # Building with tests and benchmarks... # build & run tests, build benchmarks - - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # Testing... - - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # cabal check... - - (cd github-* && ${CABAL} -vnormal check) + - (cd ${PKGDIR_github} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_github_samples} && ${CABAL} -vnormal check) # haddock... - - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi # Building without installed constraints for packages in global-db... - rm -f cabal.project.local - - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output -# REGENDATA ["--branches","master","-o",".travis.yml","github.cabal"] +# REGENDATA ["--config=cabal.haskell-ci","cabal.project"] # EOF diff --git a/cabal.haskell-ci b/cabal.haskell-ci new file mode 100644 index 00000000..bcb8a5d9 --- /dev/null +++ b/cabal.haskell-ci @@ -0,0 +1,2 @@ +branches: master +haddock: >=8.6 diff --git a/cabal.project b/cabal.project index b74f6712..26dc579d 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,5 @@ -packages: - "." - samples +packages: . +packages: samples optimization: False tests: True @@ -8,7 +7,4 @@ tests: True constraints: hashable ^>=1.3 constraints: semigroups ^>=0.19 -allow-newer: aeson-1.4.3.0:hashable -allow-newer: aeson-1.4.3.0:semigroups - constraints: github +openssl diff --git a/github.cabal b/github.cabal index e0be1ae2..0a690566 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.22 +version: 0.23 synopsis: Access to the GitHub API, v3. category: Network description: @@ -30,7 +30,13 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 + GHC ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.1 extra-source-files: README.md @@ -49,8 +55,8 @@ source-repository head flag openssl description: "Use http-client-openssl" - manual: True - default: False + manual: True + default: False library default-language: Haskell2010 @@ -106,8 +112,8 @@ library GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events - GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Notifications + GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments @@ -135,10 +141,10 @@ library 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.Repos.Invitations GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails @@ -149,7 +155,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.13 + base >=4.7 && <4.14 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 @@ -162,7 +168,7 @@ library -- other packages build-depends: aeson >=1.4.0.0 && <1.5 - , base-compat >=0.10.4 && <0.11 + , base-compat >=0.10.4 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 @@ -182,17 +188,17 @@ library if flag(openssl) build-depends: - http-client-openssl >=0.3.0.0 && <0.4 - , HsOpenSSL >=0.11.4.16 && <0.12 - , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + HsOpenSSL >=0.11.4.16 && <0.12 + , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + , http-client-openssl >=0.2.2.0 && <0.4 + else build-depends: - http-client-tls >=0.3.5.3 && <0.4 - , tls >=1.4.1 + http-client-tls >=0.3.5.3 && <0.4 + , tls >=1.4.1 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.5 && <0.20 + if !impl(ghc >=8.0) + build-depends: semigroups >=0.18.5 && <0.20 test-suite github-test default-language: Haskell2010 @@ -208,8 +214,8 @@ test-suite github-test GitHub.EventsSpec GitHub.IssuesSpec GitHub.OrganizationsSpec - GitHub.PullRequestReviewsSpec GitHub.PublicSSHKeysSpec + GitHub.PullRequestReviewsSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec @@ -224,8 +230,8 @@ test-suite github-test , bytestring , file-embed , github + , hspec >=2.6.1 && <2.8 , tagged , text - , hspec >=2.6.1 && <2.8 , unordered-containers , vector 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/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/github-samples.cabal b/samples/github-samples.cabal index 4595e3dd..07538abc 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,324 +1,170 @@ -name: github-samples -version: 0.0.0 -build-type: Simple -cabal-version: >= 1.10 +cabal-version: 2.2 +name: github-samples +version: 0.0.0 +category: Examples +synopsis: Samples for github package +license: BSD-3-Clause +license-file: LICENSE +maintainer: Oleg Grenrus +description: Various samples of github package +build-type: Simple +tested-with: + GHC ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.1 library - hs-source-dirs: - src - ghc-options: -Wall + hs-source-dirs: src + ghc-options: -Wall build-depends: - base - , base-compat + , base >=4.7 && <5 + , base-compat-batteries , github , text - exposed-modules: - Common + + exposed-modules: Common default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall +-- executable github-operational +-- main-is: Operational.hs +-- hs-source-dirs: +-- Operational +-- ghc-options: -Wall +-- build-depends: +-- base <5 +-- , base-compat-batteries +-- , github +-- , text +-- , github-samples +-- , http-client +-- , http-client-tls +-- , operational +-- , transformers +-- , transformers-compat +-- default-language: Haskell2010 + +common deps + default-language: Haskell2010 + ghc-options: -Wall build-depends: - base - , base-compat + , base >=4.7 && <5 + , base-compat-batteries + , base64-bytestring , github - , text , github-samples - 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 - main-is: CreateDeployKey.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: CreateDeployKey.hs + hs-source-dirs: Repos/DeployKeys executable github-delete-deploy-key - main-is: DeleteDeployKey.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeleteDeployKey.hs + hs-source-dirs: Repos/DeployKeys executable github-delete-team - main-is: DeleteTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeleteTeam.hs + hs-source-dirs: Teams executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeleteTeamMembershipFor.hs + hs-source-dirs: Teams/Memberships executable github-edit-team - main-is: EditTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: EditTeam.hs + hs-source-dirs: Teams executable github-list-deploy-keys-for - main-is: ListDeployKeys.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , vector - default-language: Haskell2010 + 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 - 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 - default-language: Haskell2010 + 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 - 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 - default-language: Haskell2010 + import: deps + main-is: ListTeamsCurrent.hs + hs-source-dirs: Teams 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 - 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: ListRepos.hs + hs-source-dirs: Teams executable github-repos-contents-example - main-is: Contents.hs - hs-source-dirs: - Repos - ghc-options: -Wall - build-depends: - base - , base-compat - , base64-bytestring - , github - , github-samples - , text - , vector - default-language: Haskell2010 + import: deps + main-is: Contents.hs + hs-source-dirs: Repos executable github-show-deploy-key - main-is: ShowDeployKey.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ShowDeployKey.hs + hs-source-dirs: Repos/DeployKeys executable github-show-user - main-is: ShowUser.hs - hs-source-dirs: - Users - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - 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 - default-language: Haskell2010 + import: deps + main-is: ShowUser2.hs + hs-source-dirs: Users 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 - default-language: Haskell2010 + 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 - default-language: Haskell2010 + import: deps + main-is: TeamInfoFor.hs + hs-source-dirs: Teams executable github-create-public-ssh-key - main-is: CreatePublicSSHKey.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: CreatePublicSSHKey.hs + hs-source-dirs: Users/PublicSSHKeys executable github-delete-public-ssh-key - main-is: DeletePublicSSHKey.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeletePublicSSHKey.hs + hs-source-dirs: Users/PublicSSHKeys executable github-list-public-ssh-keys - main-is: ListPublicSSHKeys.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , vector - default-language: Haskell2010 + import: deps + main-is: ListPublicSSHKeys.hs + hs-source-dirs: Users/PublicSSHKeys executable github-get-public-ssh-key - main-is: ShowPublicSSHKey.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ShowPublicSSHKey.hs + hs-source-dirs: Users/PublicSSHKeys diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index 606d4077..9e65485d 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -12,6 +12,10 @@ module GitHub.Data.Deployments , CreateDeploymentStatus (..) ) where + +import GitHub.Internal.Prelude +import Prelude () + import Control.Arrow (second) import Data.ByteString (ByteString) @@ -24,7 +28,6 @@ import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) -import GitHub.Internal.Prelude import qualified Data.Aeson as JSON import qualified Data.Text as T From 0ce3767d41c3a9ed1e548ef7aeb1fdb8543d0a11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Wed, 4 Sep 2019 16:38:23 +0200 Subject: [PATCH 178/309] OwnerType: add OwnerBot --- fixtures/user-bot.json | 32 ++++++++++++++++++++++++++++++++ github.cabal | 1 + spec/GitHub/UsersSpec.hs | 4 ++++ src/GitHub/Data/Definitions.hs | 8 +++++--- 4 files changed, 42 insertions(+), 3 deletions(-) create mode 100644 fixtures/user-bot.json 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 e0be1ae2..86897e16 100644 --- a/github.cabal +++ b/github.cabal @@ -42,6 +42,7 @@ extra-source-files: fixtures/pull-request-review-requested.json fixtures/user-organizations.json fixtures/user.json + fixtures/user-bot.json source-repository head type: git diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index b0b201c2..6e55b649 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -41,6 +41,10 @@ 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" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index de7f4e54..f4503e66 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -32,7 +32,7 @@ data Error instance E.Exception Error -- | Type of the repository owners. -data OwnerType = OwnerUser | OwnerOrganization +data OwnerType = OwnerUser | OwnerOrganization | OwnerBot deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) instance NFData OwnerType @@ -77,7 +77,7 @@ data User = User { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) - , userType :: !OwnerType -- ^ Should always be 'OwnerUser' + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' , userCreatedAt :: !UTCTime , userPublicGists :: !Int , userAvatarUrl :: !URL @@ -137,6 +137,7 @@ instance FromJSON OwnerType where parseJSON = withText "OwnerType" $ \t -> case T.toLower t of "user" -> pure $ OwnerUser "organization" -> pure $ OwnerOrganization + "bot" -> pure $ OwnerBot _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where @@ -205,7 +206,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 @@ -215,6 +216,7 @@ 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. From fb2aeb6968fed63c29b952d2aa512b91337f7a9e Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Sun, 29 Sep 2019 13:58:43 -0700 Subject: [PATCH 179/309] Make File.fileSha optional. (#392) * Make File.fileSha optional. GitHub API for comparing commits returns a null "sha" field when the only change to a file is to its file system permissions. See the following repository for a complete example. https://github.com/scott-fleischman/repo-change-file-permission Example API call: https://api.github.com/repos/scott-fleischman/repo-change-file-permission/compare/80fdf8f83fcd8181411919fbf47394b878c591a0...77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27 Response highlight: ``` "files": [ { "sha": null, "filename": "echo-script", "status": "modified", "additions": 0, "deletions": 0, "changes": 0, "blob_url": "https://github.com/scott-fleischman/repo-change-file-permission/blob/77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27/echo-script", "raw_url": "https://github.com/scott-fleischman/repo-change-file-permission/raw/77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27/echo-script", "contents_url": "https://api.github.com/repos/scott-fleischman/repo-change-file-permission/contents/echo-script?ref=77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27" } ] ``` * Allow sha field to be missing in JSON serialization. * Use Common import. --- samples/Repos/Commits/GitDiff.hs | 25 +++++++++++++++++-------- samples/github-samples.cabal | 5 +++++ src/GitHub/Data/GitData.hs | 4 ++-- 3 files changed, 24 insertions(+), 10 deletions(-) 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/github-samples.cabal b/samples/github-samples.cabal index 07538abc..583629cc 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -168,3 +168,8 @@ 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/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index edeef245..bce1cb52 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -188,7 +188,7 @@ data File = File , fileStatus :: !Text , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int - , fileSha :: !Text + , fileSha :: !(Maybe Text) , fileChanges :: !Int , filePatch :: !(Maybe Text) , fileFilename :: !Text @@ -255,7 +255,7 @@ instance FromJSON File where <*> o .: "status" <*> o .:? "raw_url" <*> o .: "additions" - <*> o .: "sha" + <*> o .:? "sha" <*> o .: "changes" <*> o .:? "patch" <*> o .: "filename" From eeb6b429365ca9b809295d8bc83f8cb968699b70 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:03:12 +0300 Subject: [PATCH 180/309] Add changelog entries --- CHANGELOG.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b637c8e..452b4690 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,9 @@ -## Changes for next +## Changes for 0.23 + +- Add OwnerBot to OwnerType + [#399](https://github.com/phadej/github/pull/399) +- Make File.fileSha optional + [#392](https://github.com/phadej/github/pull/392) ## Changes for 0.22 From 787c8dbf749e7574b559e1b223f9dcb0bec4406a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:07:03 +0300 Subject: [PATCH 181/309] Keep User-Agent header up to date --- CHANGELOG.md | 3 +++ github.cabal | 2 ++ src/GitHub/Request.hs | 10 +++++++--- 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 452b4690..880008de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,9 @@ [#399](https://github.com/phadej/github/pull/399) - Make File.fileSha optional [#392](https://github.com/phadej/github/pull/392) +- Update User-Agent to contain up to date version + [#403](https://github.com/phadej/github/pull/403) + [#394](https://github.com/phadej/github/pull/394) ## Changes for 0.22 diff --git a/github.cabal b/github.cabal index 49495443..33df9fe2 100644 --- a/github.cabal +++ b/github.cabal @@ -154,6 +154,8 @@ library GitHub.Internal.Prelude GitHub.Request + other-modules: Paths_github + -- Packages bundles with GHC, mtl and text are also here build-depends: base >=4.7 && <4.14 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 2ad73a30..d2fad11c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -68,7 +68,9 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.String (fromString) import Data.Tagged (Tagged (..)) +import Data.Version (showVersion) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), getUri, @@ -88,11 +90,11 @@ 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) +import Network.HTTP.Client.TLS (tlsManagerSettings) #else import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified OpenSSL.Session as SSL +import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL #endif @@ -101,6 +103,8 @@ import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request +import Paths_github (version) + #ifdef MIN_VERSION_http_client_tls withOpenSSL :: IO a -> IO a withOpenSSL = id @@ -418,7 +422,7 @@ makeHttpRequest auth r = case r of setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = [("User-Agent", "github.hs/0.21")] -- Version + reqHeaders = [("User-Agent", "github.hs/" <> fromString (showVersion version))] -- Version <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request From 098031a3fd015b72ded982e64017a6ae7352c6d2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:20:15 +0300 Subject: [PATCH 182/309] Escape URI paths Resolves https://github.com/phadej/github/issues/398 --- .gitignore | 1 + CHANGELOG.md | 2 ++ src/GitHub/Request.hs | 9 ++++++--- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index 5b3e088e..452bddc6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +.env dist dist-newstyle .ghc.environment.* diff --git a/CHANGELOG.md b/CHANGELOG.md index 880008de..fa23d79e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ ## Changes for 0.23 +- Escape URI paths + [#404](https://github.com/phadej/github/pull/404) - Add OwnerBot to OwnerType [#399](https://github.com/phadej/github/pull/399) - Make File.fileSha optional diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index d2fad11c..73c8be1b 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -67,7 +67,7 @@ import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) -import Data.List (find) +import Data.List (find, intercalate) import Data.String (fromString) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -79,7 +79,9 @@ import Network.HTTP.Client 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, parseURIReference, relativeTo) +import Network.URI + (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, + relativeTo) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -413,7 +415,8 @@ makeHttpRequest auth r = case r of parseUrl' = HTTP.parseUrlThrow . T.unpack url :: Paths -> Text - url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths + url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.pack (intercalate "/" paths') where + paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } From a40db0d5365de175c01e0db5b97c7f477df812b8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:25:50 +0300 Subject: [PATCH 183/309] Less T.pack / T.unpack --- src/GitHub/Request.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 73c8be1b..04d13c6d 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -411,11 +411,11 @@ makeHttpRequest auth r = case r of . setMethod (toMethod m) $ req where - parseUrl' :: MonadThrow m => Text -> m HTTP.Request - parseUrl' = HTTP.parseUrlThrow . T.unpack + parseUrl' :: MonadThrow m => String -> m HTTP.Request + parseUrl' = HTTP.parseUrlThrow - url :: Paths -> Text - url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.pack (intercalate "/" paths') where + 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 From 6c743cfcb93420a01192105e5f1d86bf181d51d0 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Mon, 7 Oct 2019 14:40:06 +0900 Subject: [PATCH 184/309] Update EditRepo type --- src/GitHub/Data/Repos.hs | 57 +++++++++++++++++++++++++--------------- 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index c476fbbb..3cb61f1d 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -91,13 +91,18 @@ 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) + { editName :: !(Maybe (Name Repo)) + , editDescription :: !(Maybe Text) + , editHomepage :: !(Maybe Text) + , editPrivate :: !(Maybe Bool) + , editHasIssues :: !(Maybe Bool) + , editHasProjects :: !(Maybe Bool) + , editHasWiki :: !(Maybe Bool) + , editDefaultBranch :: !(Maybe Text) + , editAllowSquashMerge :: !(Maybe Bool) + , editAllowMergeCommit :: !(Maybe Bool) + , editAllowRebaseMerge :: !(Maybe Bool) + , editArchived :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) @@ -199,21 +204,31 @@ instance ToJSON NewRepo where ] 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 RepoRef where From ea74dcb62fb1c5db9c8b386dca88ea6708d64816 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Wed, 16 Oct 2019 14:16:01 -0500 Subject: [PATCH 185/309] Pull requests reviews API uses issue number The pull requests reviews API uses issue numbers, not pull request IDs. --- spec/GitHub/PullRequestReviewsSpec.hs | 4 ++-- src/GitHub/Endpoints/PullRequests/Reviews.hs | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index d79e806f..8721efc9 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -2,7 +2,7 @@ module GitHub.PullRequestReviewsSpec where import qualified GitHub -import GitHub.Data.Id (Id (Id)) +import GitHub.Data (IssueNumber (IssueNumber)) import Prelude () import Prelude.Compat @@ -29,4 +29,4 @@ spec = do cs `shouldSatisfy` isRight where prs = - [("phadej", "github", Id 268)] + [("phadej", "github", IssueNumber 268)] diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 2143dcd5..afbc158c 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -29,7 +29,7 @@ import Prelude () pullRequestReviewsR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> FetchCount -> Request k (Vector Review) pullRequestReviewsR owner repo prid = @@ -50,7 +50,7 @@ pullRequestReviewsR owner repo prid = pullRequestReviews :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> IO (Either Error (Vector Review)) pullRequestReviews owner repo prid = executeRequest' $ pullRequestReviewsR owner repo prid FetchAll @@ -63,7 +63,7 @@ pullRequestReviews' :: Maybe Auth -> Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> IO (Either Error (Vector Review)) pullRequestReviews' auth owner repo pr = executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll @@ -73,7 +73,7 @@ pullRequestReviews' auth owner repo pr = pullRequestReviewR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> Request k Review pullRequestReviewR owner repo prid rid = @@ -95,7 +95,7 @@ pullRequestReviewR owner repo prid rid = pullRequestReview :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error Review) pullRequestReview owner repo prid rid = @@ -110,7 +110,7 @@ pullRequestReview' :: Maybe Auth -> Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error Review) pullRequestReview' auth owner repo prid rid = @@ -121,7 +121,7 @@ pullRequestReview' auth owner repo prid rid = pullRequestReviewCommentsR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> Request k [ReviewComment] pullRequestReviewCommentsR owner repo prid rid = @@ -144,7 +144,7 @@ pullRequestReviewCommentsR owner repo prid rid = pullRequestReviewCommentsIO :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO owner repo prid rid = @@ -158,7 +158,7 @@ pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO' auth owner repo prid rid = From 28e82b94177b113e94b4027efed85a25845e6fdd Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Sun, 20 Oct 2019 12:25:29 +0900 Subject: [PATCH 186/309] Update Repo type --- src/GitHub/Data/Repos.hs | 90 ++++++++++++++++++++-------------------- 1 file changed, 46 insertions(+), 44 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 3cb61f1d..5819a3d0 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -29,36 +29,37 @@ import Unsafe.Coerce (unsafeCoerce) #endif data Repo = Repo - { repoSshUrl :: !(Maybe URL) - , repoDescription :: !(Maybe Text) - , repoCreatedAt :: !(Maybe UTCTime) + { repoId :: !(Id Repo) + , repoName :: !(Name Repo) + , repoOwner :: !SimpleOwner + , repoPrivate :: !Bool , repoHtmlUrl :: !URL - , repoSvnUrl :: !(Maybe URL) - , repoForks :: !(Maybe Int) - , repoHomepage :: !(Maybe Text) + , repoDescription :: !(Maybe Text) , repoFork :: !(Maybe Bool) + , repoUrl :: !URL , repoGitUrl :: !(Maybe URL) - , repoPrivate :: !Bool - , repoArchived :: !Bool + , repoSshUrl :: !(Maybe URL) , repoCloneUrl :: !(Maybe URL) - , repoSize :: !(Maybe Int) - , repoUpdatedAt :: !(Maybe UTCTime) - , repoWatchers :: !(Maybe Int) - , repoOwner :: !SimpleOwner - , repoName :: !(Name Repo) + , repoHooksUrl :: !URL + , repoSvnUrl :: !(Maybe URL) + , repoHomepage :: !(Maybe Text) , repoLanguage :: !(Maybe Language) + , repoForksCount :: !Int + , repoStargazersCount :: !Int + , repoWatchersCount :: !Int + , repoSize :: !(Maybe Int) , repoDefaultBranch :: !(Maybe Text) - , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories - , repoId :: !(Id Repo) - , repoUrl :: !URL - , repoOpenIssues :: !(Maybe Int) - , repoHasWiki :: !(Maybe Bool) + , repoOpenIssuesCount :: !Int , repoHasIssues :: !(Maybe Bool) + , repoHasProjects :: !(Maybe Bool) + , repoHasWiki :: !(Maybe Bool) + , repoHasPages :: !(Maybe Bool) , repoHasDownloads :: !(Maybe Bool) - , repoParent :: !(Maybe RepoRef) - , repoSource :: !(Maybe RepoRef) - , repoHooksUrl :: !URL - , repoStargazersCount :: !Int + , repoArchived :: !Bool + , repoDisabled :: !Bool + , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , repoCreatedAt :: !(Maybe UTCTime) + , repoUpdatedAt :: !(Maybe UTCTime) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -154,36 +155,37 @@ contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid -- JSON instances instance FromJSON Repo where - parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" - <*> o .: "description" - <*> o .:? "created_at" + parseJSON = withObject "Repo" $ \o -> Repo <$> o .: "id" + <*> o .: "name" + <*> o .: "owner" + <*> o .: "private" <*> o .: "html_url" - <*> o .:? "svn_url" - <*> o .:? "forks" - <*> o .:? "homepage" + <*> o .:? "description" <*> o .: "fork" + <*> o .: "url" <*> o .:? "git_url" - <*> o .: "private" - <*> o .:? "archived" .!= False + <*> o .:? "ssh_url" <*> o .:? "clone_url" - <*> o .:? "size" - <*> o .:? "updated_at" - <*> o .:? "watchers" - <*> o .: "owner" - <*> o .: "name" + <*> 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 .:? "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .:? "open_issues" - <*> o .:? "has_wiki" + <*> o .: "open_issues_count" <*> o .:? "has_issues" + <*> o .:? "has_projects" + <*> o .:? "has_wiki" + <*> o .:? "has_pages" <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" + <*> o .:? "archived" .!= False + <*> o .:? "disabled" .!= False + <*> o .:? "pushed_at" + <*> o .:? "created_at" + <*> o .:? "updated_at" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name From 56977c72e0c8bf614f1a63d175a824a37bde5897 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Sun, 20 Oct 2019 17:02:25 +0900 Subject: [PATCH 187/309] Update NewRepo type --- src/GitHub/Data/Repos.hs | 48 +++++++++++++++++++++++++++------------- 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 5819a3d0..8486fb6a 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -76,20 +76,26 @@ instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef data NewRepo = NewRepo - { newRepoName :: !(Name Repo) - , newRepoDescription :: !(Maybe Text) - , newRepoHomepage :: !(Maybe Text) - , newRepoPrivate :: !(Maybe Bool) - , newRepoHasIssues :: !(Maybe Bool) - , newRepoHasWiki :: !(Maybe Bool) - , newRepoAutoInit :: !(Maybe Bool) + { 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, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf instance Binary NewRepo newRepo :: Name Repo -> NewRepo -newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing +newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing data EditRepo = EditRepo { editName :: !(Maybe (Name Repo)) @@ -188,21 +194,33 @@ instance FromJSON Repo where <*> o .:? "updated_at" 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 From 87a88ac8d3456347a637ed6821cc75690f5f1a0c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 22 Oct 2019 12:51:35 +0300 Subject: [PATCH 188/309] Resolve #402: Use openssl in operational sample --- samples/Operational/Operational.hs | 23 ++++++++++++++----- samples/github-samples.cabal | 36 ++++++++++++++++-------------- 2 files changed, 37 insertions(+), 22 deletions(-) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index b84f9ab9..ea8208e7 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -7,11 +7,13 @@ import Common import Prelude () import Control.Monad.Operational -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Network.HTTP.Client (Manager, newManager) -import Network.HTTP.Client.TLS (tlsManagerSettings) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Network.HTTP.Client (Manager, newManager, ManagerSettings) +import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified GitHub as GH +import qualified GitHub as GH +import qualified OpenSSL.Session as SSL +import qualified OpenSSL.X509.SystemStore as SSL data R a where R :: FromJSON a => GH.Request 'GH.RA a -> R a @@ -29,7 +31,7 @@ githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton . R main :: IO () -main = do +main = withOpenSSL $ do manager <- newManager tlsManagerSettings auth' <- getAuth case auth' of @@ -39,3 +41,14 @@ main = do repo <- githubRequest $ GH.repositoryR "phadej" "github" githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner + +tlsManagerSettings :: 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 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 583629cc..0fa802e5 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -29,23 +29,25 @@ library exposed-modules: Common default-language: Haskell2010 --- executable github-operational --- main-is: Operational.hs --- hs-source-dirs: --- Operational --- ghc-options: -Wall --- build-depends: --- base <5 --- , base-compat-batteries --- , github --- , text --- , github-samples --- , http-client --- , http-client-tls --- , operational --- , transformers --- , transformers-compat --- default-language: Haskell2010 +executable github-operational + main-is: Operational.hs + hs-source-dirs: Operational + ghc-options: -Wall -threaded + build-depends: + , base >=0 && <5 + , base-compat-batteries + , github + , github-samples + , HsOpenSSL + , HsOpenSSL-x509-system + , http-client + , http-client-openssl + , operational + , text + , transformers + , transformers-compat + + default-language: Haskell2010 common deps default-language: Haskell2010 From a70721b5e90ec9bb2a7b1b20771c0db10b988709 Mon Sep 17 00:00:00 2001 From: Dmitry Ivanov Date: Tue, 26 Nov 2019 12:55:10 +0100 Subject: [PATCH 189/309] Remove redundant withOpenSSL Unless it was intentional? I didn't find anything about double application in its documentation. --- src/GitHub/Request.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 04d13c6d..dee15fb8 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -129,7 +129,7 @@ executeRequest => am -> GenRequest mt rw a -> IO (Either Error a) -executeRequest auth req = withOpenSSL $ withOpenSSL $ do +executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req From a04cba6b0e3ff113a0c4c6d655b78ee9a7bd11fc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 03:30:59 +0200 Subject: [PATCH 190/309] Re-export deploy keys from GitHub module --- src/GitHub.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index f847e45d..321c5de7 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -283,6 +283,13 @@ module GitHub ( commitR, diffR, + -- ** Deploy Keys + -- | See + deployKeysForR, + deployKeyForR, + createRepoDeployKeyR, + deleteRepoDeployKeyR, + -- ** Deployments -- | See -- @@ -419,6 +426,7 @@ import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits +import GitHub.Endpoints.Repos.DeployKeys import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Invitations From 299507c7450305defd14ce3e3204c19df96276e3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Nov 2019 19:23:38 +0200 Subject: [PATCH 191/309] Add github and github' convinience functions --- README.md | 7 ++-- github.cabal | 2 +- src/GitHub.hs | 10 ++++-- src/GitHub/Request.hs | 76 +++++++++++++++++++++++++++++++++++++++---- 4 files changed, 83 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 9136e437..877c51dc 100644 --- a/README.md +++ b/README.md @@ -63,11 +63,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 @@ -98,7 +99,7 @@ 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. diff --git a/github.cabal b/github.cabal index 33df9fe2..ff5c3c2a 100644 --- a/github.cabal +++ b/github.cabal @@ -15,7 +15,7 @@ description: > > main :: IO () > main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" + > possibleUser <- GH.github' GH.userInfoForR "phadej" > print possibleUser . For more of an overview please see the README: diff --git a/src/GitHub.hs b/src/GitHub.hs index 321c5de7..ab660395 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -6,11 +6,17 @@ -- This module re-exports all request constructrors and data definitions from -- this package. -- --- See "GitHub.Request" module for executing 'Request', or other modules --- of this package (e.g. "GitHub.Endpoints.Users") for already composed versions. +-- 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 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index dee15fb8..83eba89b 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,9 +1,11 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -29,6 +31,11 @@ -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( + -- * A convinient execution of requests + github, + github', + GitHubRW, + GitHubRO, -- * Types Request, GenRequest (..), @@ -107,6 +114,63 @@ import GitHub.Data.Request import Paths_github (version) +------------------------------------------------------------------------------- +-- Convinience +------------------------------------------------------------------------------- + +-- | A convinience 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 From 75fa30bfd14599ba09031ad63215d14e7a239d3d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 02:26:42 +0200 Subject: [PATCH 192/309] Remove precomposed executeRequest functions Users are adviced to use `github` combinator. This change allows to remove more than a half of symbols, which can be recovered by a single combinator. This makes library at lot slickier. --- samples/RateLimit.hs | 1 - samples/Repos/DeployKeys/CreateDeployKey.hs | 16 +- samples/Repos/DeployKeys/ListDeployKeys.hs | 12 +- samples/Repos/ShowRepo.hs | 19 +- samples/Teams/EditTeam.hs | 4 +- samples/Teams/ListRepos.hs | 7 +- samples/Teams/ListTeamsCurrent.hs | 5 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 16 +- samples/Teams/TeamInfoFor.hs | 7 +- samples/Users/ShowUser.hs | 45 ++-- samples/github-samples.cabal | 122 +++++------ spec/GitHub/ActivitySpec.hs | 1 - spec/GitHub/CommitsSpec.hs | 20 +- spec/GitHub/OrganizationsSpec.hs | 9 +- spec/GitHub/PublicSSHKeysSpec.hs | 11 +- spec/GitHub/ReleasesSpec.hs | 1 - spec/GitHub/ReposSpec.hs | 20 +- spec/GitHub/SearchSpec.hs | 5 +- spec/GitHub/UsersSpec.hs | 22 +- src/GitHub.hs | 9 - .../Endpoints/Activity/Notifications.hs | 19 +- src/GitHub/Endpoints/Activity/Starring.hs | 40 ---- src/GitHub/Endpoints/Activity/Watching.hs | 33 --- src/GitHub/Endpoints/Gists.hs | 52 ----- src/GitHub/Endpoints/Gists/Comments.hs | 17 -- src/GitHub/Endpoints/GitData/Blobs.hs | 17 -- src/GitHub/Endpoints/GitData/Commits.hs | 10 - src/GitHub/Endpoints/GitData/References.hs | 48 +---- src/GitHub/Endpoints/GitData/Trees.hs | 31 --- src/GitHub/Endpoints/Issues.hs | 56 ----- src/GitHub/Endpoints/Issues/Comments.hs | 53 ----- src/GitHub/Endpoints/Issues/Events.hs | 46 ----- src/GitHub/Endpoints/Issues/Labels.hs | 135 ------------ src/GitHub/Endpoints/Issues/Milestones.hs | 36 ---- src/GitHub/Endpoints/Organizations.hs | 30 --- src/GitHub/Endpoints/Organizations/Members.hs | 35 ---- src/GitHub/Endpoints/Organizations/Teams.hs | 127 ------------ src/GitHub/Endpoints/PullRequests.hs | 125 ----------- src/GitHub/Endpoints/PullRequests/Comments.hs | 27 --- src/GitHub/Endpoints/PullRequests/Reviews.hs | 88 -------- src/GitHub/Endpoints/RateLimit.hs | 14 -- src/GitHub/Endpoints/Repos.hs | 194 ------------------ src/GitHub/Endpoints/Repos/Collaborators.hs | 40 ---- src/GitHub/Endpoints/Repos/Comments.hs | 48 ----- src/GitHub/Endpoints/Repos/Commits.hs | 63 ------ src/GitHub/Endpoints/Repos/Contents.hs | 82 -------- src/GitHub/Endpoints/Repos/DeployKeys.hs | 24 --- src/GitHub/Endpoints/Repos/Forks.hs | 17 -- src/GitHub/Endpoints/Repos/Releases.hs | 61 ------ src/GitHub/Endpoints/Repos/Statuses.hs | 29 --- src/GitHub/Endpoints/Repos/Webhooks.hs | 38 ---- src/GitHub/Endpoints/Search.hs | 49 ----- src/GitHub/Endpoints/Users.hs | 32 +-- src/GitHub/Endpoints/Users/Emails.hs | 17 -- src/GitHub/Endpoints/Users/Followers.hs | 17 -- src/GitHub/Endpoints/Users/PublicSSHKeys.hs | 30 --- 56 files changed, 177 insertions(+), 1955 deletions(-) diff --git a/samples/RateLimit.hs b/samples/RateLimit.hs index c0cabd5f..399fd925 100644 --- a/samples/RateLimit.hs +++ b/samples/RateLimit.hs @@ -5,4 +5,3 @@ import qualified Github.RateLimit as Github main = do x <- Github.rateLimit print x - diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs index f95f3079..953e299a 100644 --- a/samples/Repos/DeployKeys/CreateDeployKey.hs +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -1,21 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified GitHub.Data.DeployKeys as DK -import qualified GitHub.Endpoints.Repos.DeployKeys as DK -import qualified GitHub.Auth as Auth +import qualified GitHub as GH import Data.Text (Text) main :: IO () main = do - let auth = Auth.OAuth "auth_token" - eDeployKey <- DK.createRepoDeployKey' auth "your_owner" "your_repo" newDeployKey + 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) -> putStrLn $ show deployKey + Left err -> putStrLn $ "Error: " ++ show err + Right deployKey -> print deployKey -newDeployKey :: DK.NewRepoDeployKey -newDeployKey = DK.NewRepoDeployKey publicKey "test-key" True +newDeployKey :: GH.NewRepoDeployKey +newDeployKey = GH.NewRepoDeployKey publicKey "test-key" True where publicKey :: Text publicKey = "your_public_key" diff --git a/samples/Repos/DeployKeys/ListDeployKeys.hs b/samples/Repos/DeployKeys/ListDeployKeys.hs index bde0b665..070eb297 100644 --- a/samples/Repos/DeployKeys/ListDeployKeys.hs +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -1,19 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified GitHub.Data.DeployKeys as DK -import qualified GitHub.Endpoints.Repos.DeployKeys as DK -import qualified GitHub.Auth as Auth +import qualified GitHub as GH import Data.List (intercalate) import Data.Vector (toList) main :: IO () main = do - let auth = Auth.OAuth "auth_token" - eDeployKeys <- DK.deployKeysFor' auth "your_owner" "your_repo" + 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) + 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/ShowRepo.hs b/samples/Repos/ShowRepo.hs index 5007cfdc..ac72069a 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -7,18 +7,17 @@ import Data.Maybe main = do 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/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index 7e3f63a1..bb0a05ca 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -5,15 +5,15 @@ 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, 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) _ -> 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 4e75aa6a..eefd1e70 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -4,14 +4,13 @@ module Main (main) where import Common -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 b07bee73..58c120a2 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -5,20 +5,18 @@ module Main (main) where import Common import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of - [token, team_id, username] -> - GitHub.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/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index c128e8b8..7a8744f8 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -4,15 +4,14 @@ module Main (main) where import Common -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/ShowUser.hs b/samples/Users/ShowUser.hs index d5b8f09a..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" <> - GitHub.getUrl 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 0fa802e5..f0d4a4e7 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: github-samples -version: 0.0.0 +version: 0 category: Examples synopsis: Samples for github package license: BSD-3-Clause @@ -71,40 +71,40 @@ executable github-create-deploy-key main-is: CreateDeployKey.hs hs-source-dirs: Repos/DeployKeys -executable github-delete-deploy-key - import: deps - main-is: DeleteDeployKey.hs - hs-source-dirs: Repos/DeployKeys +-- 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 +-- 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-delete-team-membership-for +-- import: deps +-- main-is: DeleteTeamMembershipFor.hs +-- hs-source-dirs: Teams/Memberships executable github-edit-team import: deps main-is: EditTeam.hs hs-source-dirs: Teams -executable github-list-deploy-keys-for - import: deps - main-is: ListDeployKeys.hs - hs-source-dirs: Repos/DeployKeys +-- executable github-list-deploy-keys-for +-- import: deps +-- main-is: ListDeployKeys.hs +-- hs-source-dirs: Repos/DeployKeys executable github-list-followers import: deps main-is: ListFollowers.hs hs-source-dirs: Users/Followers -executable github-list-followers-example - import: deps - main-is: Example.hs - hs-source-dirs: Users/Followers +-- executable github-list-followers-example +-- import: deps +-- main-is: Example.hs +-- hs-source-dirs: Users/Followers executable github-list-following import: deps @@ -116,20 +116,20 @@ executable github-list-team-current 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-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-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-deploy-key +-- import: deps +-- main-is: ShowDeployKey.hs +-- hs-source-dirs: Repos/DeployKeys executable github-show-user import: deps @@ -141,37 +141,37 @@ executable github-show-user-2 main-is: ShowUser2.hs hs-source-dirs: Users -executable github-team-membership-info-for - import: deps - main-is: TeamMembershipInfoFor.hs - hs-source-dirs: Teams/Memberships +-- executable github-team-membership-info-for +-- import: deps +-- main-is: TeamMembershipInfoFor.hs +-- hs-source-dirs: Teams/Memberships executable github-teaminfo-for import: deps main-is: TeamInfoFor.hs hs-source-dirs: Teams -executable github-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 +-- 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/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index aaee99a7..1f3c82c3 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where import qualified GitHub diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 3bf5fc53..5bf2d6a0 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -1,13 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where -import qualified GitHub - import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (commitSha, commitsFor', - commitsForR, diffR, mkCommitName) -import GitHub.Request (executeRequest) +import GitHub.Endpoints.Repos.Commits (commitSha, commitsForR, diffR, mkCommitName, FetchCount (..)) +import GitHub.Request (github) import Control.Monad (forM_) import Data.Either.Compat (isRight) @@ -34,13 +30,13 @@ spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do - cs <- commitsFor' (Just auth) "phadej" "github" + cs <- github auth commitsForR "phadej" "github" FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 40) + cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -49,19 +45,19 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) + cs <- github auth commitsForR "phadej" "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 "phadej" "github" (commitSha a) (commitSha b) d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do - d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") + d <- 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 <- executeRequest auth $ diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" + d <- github auth diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" d `shouldSatisfy` isRight diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index 171a29ed..b6e7aea3 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -2,11 +2,12 @@ {-# 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.Endpoints.Organizations (publicOrganizationsForR) +import GitHub.Endpoints.Organizations.Members (membersOfR) import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isRight) @@ -35,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 @@ -49,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 index b797c959..25b17dae 100644 --- a/spec/GitHub/PublicSSHKeysSpec.hs +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.PublicSSHKeysSpec where import GitHub - (Auth (..), FetchCount (..), PublicSSHKey (..), executeRequest) + (Auth (..), FetchCount (..), PublicSSHKey (..),github) import GitHub.Endpoints.Users.PublicSSHKeys - (publicSSHKey', publicSSHKeys', publicSSHKeysForR) + (publicSSHKeyR, publicSSHKeysR, publicSSHKeysForR) import Data.Either.Compat (isRight) import Data.String (fromString) @@ -29,13 +28,13 @@ spec :: Spec spec = do describe "publicSSHKeysFor'" $ do it "works" $ withAuth $ \auth -> do - keys <- executeRequest auth $ publicSSHKeysForR "phadej" FetchAll + keys <- github auth publicSSHKeysForR "phadej" FetchAll V.length (fromRightS keys) `shouldSatisfy` (> 1) describe "publicSSHKeys' and publicSSHKey'" $ do it "works" $ withAuth $ \auth -> do - keys <- publicSSHKeys' auth + keys <- github auth publicSSHKeysR V.length (fromRightS keys) `shouldSatisfy` (> 1) - key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys)) + key <- github auth publicSSHKeyR (publicSSHKeyId $ V.head (fromRightS keys)) key `shouldSatisfy` isRight diff --git a/spec/GitHub/ReleasesSpec.hs b/spec/GitHub/ReleasesSpec.hs index db01348f..a2988f91 100644 --- a/spec/GitHub/ReleasesSpec.hs +++ b/spec/GitHub/ReleasesSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ReleasesSpec where import qualified GitHub diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index 5b6ab190..a08ca00d 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where -import GitHub (Auth (..), Repo (..), RepoPublicity (..), - executeRequest, repositoryR) -import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') +import GitHub + (Auth (..), FetchCount (..), Repo (..), RepoPublicity (..), github, + repositoryR) +import GitHub.Endpoints.Repos (currentUserReposR, languagesForR, userReposR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.HashMap.Strict as HM @@ -29,7 +29,7 @@ spec :: Spec spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do - er <- executeRequest auth $ repositoryR "phadej" "github" + er <- github auth repositoryR "phadej" "github" er `shouldSatisfy` isRight let Right r = er -- https://github.com/phadej/github/pull/219 @@ -37,16 +37,16 @@ spec = do 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 "phadej" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 64f1680a..ce82900d 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -14,9 +14,10 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V +import GitHub (github) import GitHub.Data (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssues') +import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -53,6 +54,6 @@ spec = do 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 + issues <- searchResultResults . fromRightS <$> github auth searchIssuesR query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 6e55b649..abb2a882 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -15,9 +15,9 @@ import qualified GitHub import GitHub.Data (Auth (..), Organization (..), User (..), fromOwner) import GitHub.Endpoints.Users - (ownerInfoForR, userInfoCurrent', userInfoFor') + (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 @@ -46,37 +46,37 @@ spec = do 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 + describe "userInfoCurrentR" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do - userInfo <- userInfoCurrent' auth + userInfo <- github auth userInfoCurrentR userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" (GitHub.FetchAtLeast 10) + us <- github auth usersFollowingR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) + us <- github auth usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight diff --git a/src/GitHub.hs b/src/GitHub.hs index ab660395..2faf1618 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -152,11 +152,8 @@ module GitHub ( -- milestonesR, milestoneR, - createMilestone, createMilestoneR, - updateMilestone, updateMilestoneR, - deleteMilestone, deleteMilestoneR, -- * Organizations @@ -237,14 +234,8 @@ module GitHub ( -- * Submit a pull request review -- * Dismiss a pull request review pullRequestReviewsR, - pullRequestReviews, - pullRequestReviews', pullRequestReviewR, - pullRequestReview, - pullRequestReview', pullRequestReviewCommentsR, - pullRequestReviewCommentsIO, - pullRequestReviewCommentsIO', -- * Repositories -- | See diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs index 1561390c..7c246c54 100644 --- a/src/GitHub/Endpoints/Activity/Notifications.hs +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -6,26 +6,21 @@ -- The repo watching API as described on -- . -module GitHub.Endpoints.Activity.Notifications where +module GitHub.Endpoints.Activity.Notifications ( + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -getNotifications :: Auth -> IO (Either Error (Vector Notification)) -getNotifications auth = - executeRequest auth $ getNotificationsR FetchAll - -- | List your notifications. -- See getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) getNotificationsR = pagedQuery ["notifications"] [] -markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) -markNotificationAsRead auth nid = - executeRequest auth $ markNotificationAsReadR nid - -- | Mark a thread as read. -- See markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW () @@ -34,10 +29,6 @@ markNotificationAsReadR nid = Command ["notifications", "threads", toPathPart nid] (encode ()) -markNotificationsAsRead :: Auth -> IO (Either Error ()) -markNotificationsAsRead auth = - executeRequest auth markAllNotificationsAsReadR - -- | Mark as read. -- See markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 4eccfc5b..be589db0 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -6,17 +6,11 @@ -- The repo starring API as described on -- . module GitHub.Endpoints.Activity.Starring ( - stargazersFor, stargazersForR, - reposStarredBy, reposStarredByR, - myStarred, myStarredR, - myStarredAcceptStar, myStarredAcceptStarR, - starRepo, starRepoR, - unstarRepo, unstarRepoR, module GitHub.Data, ) where @@ -24,60 +18,30 @@ module GitHub.Endpoints.Activity.Starring ( import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The list of users that have starred the specified Github repo. --- --- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -stargazersFor auth user repo = - executeRequestMaybe auth $ stargazersForR user repo FetchAll - -- | List Stargazers. -- See stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] --- | All the public repos starred by the specified user. --- --- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) -reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user FetchAll - -- | List repositories being starred. -- See reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = pagedQuery ["users", toPathPart user, "starred"] [] --- | All the repos starred by the authenticated user. -myStarred :: Auth -> IO (Either Error (Vector Repo)) -myStarred auth = - executeRequest auth $ myStarredR FetchAll - -- | All the repos starred by the authenticated user. -- See myStarredR :: FetchCount -> Request 'RA (Vector Repo) myStarredR = pagedQuery ["user", "starred"] [] - --- | All the repos starred by the authenticated user. -myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) -myStarredAcceptStar auth = - executeRequest auth $ myStarredAcceptStarR FetchAll - -- | All the repos starred by the authenticated user. -- See myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) myStarredAcceptStarR = PagedQuery ["user", "starred"] [] --- | Star a repo by the authenticated user. -starRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) -starRepo auth user repo = executeRequest auth $ starRepoR user repo - -- | Star a repo by the authenticated user. -- See starRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () @@ -85,10 +49,6 @@ starRepoR user repo = Command Put paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] --- | Unstar a repo by the authenticated user. -unstarRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) -unstarRepo auth user repo = executeRequest auth $ unstarRepoR user repo - -- | Unstar a repo by the authenticated user. -- See unstarRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index d250878e..cd58b44f 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -6,11 +6,7 @@ -- The repo watching API as described on -- . module GitHub.Endpoints.Activity.Watching ( - watchersFor, - watchersFor', watchersForR, - reposWatchedBy, - reposWatchedBy', reposWatchedByR, module GitHub.Data, ) where @@ -18,43 +14,14 @@ module GitHub.Endpoints.Activity.Watching ( import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The list of users that are watching the specified Github repo. --- --- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -watchersFor = watchersFor' Nothing - --- | The list of users that are watching the specified Github repo. --- With authentication --- --- > watchersFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -watchersFor' auth user repo = - executeRequestMaybe auth $ watchersForR user repo FetchAll - -- | List watchers. -- See watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit --- | All the public repos watched by the specified user. --- --- > reposWatchedBy "croaky" -reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) -reposWatchedBy = reposWatchedBy' Nothing - --- | All the public repos watched by the specified user. --- With authentication --- --- > reposWatchedBy' (Just $ BasicAuth "github-username" "github-password") "croaky" -reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) -reposWatchedBy' auth user = - executeRequestMaybe auth $ reposWatchedByR user FetchAll - -- | List repositories being watched. -- See reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 773e7f17..783e0588 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -5,91 +5,39 @@ -- -- The gists API as described at . module GitHub.Endpoints.Gists ( - gists, - gists', gistsR, - gist, - gist', gistR, - starGist, starGistR, - unstarGist, unstarGistR, - deleteGist, deleteGistR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The list of all gists created by the user --- --- > gists' (Just $ BasicAuth "github-username" "github-password") "mike-burns" -gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) -gists' auth user = - executeRequestMaybe auth $ gistsR user FetchAll - --- | The list of all public gists created by the user. --- --- > gists "mike-burns" -gists :: Name Owner -> IO (Either Error (Vector Gist)) -gists = gists' Nothing - -- | List gists. -- See gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] --- | A specific gist, given its id, with authentication credentials --- --- > gist' (Just $ BasicAuth "github-username" "github-password") "225074" -gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) -gist' auth gid = - executeRequestMaybe auth $ gistR gid - --- | A specific gist, given its id. --- --- > gist "225074" -gist :: Name Gist -> IO (Either Error Gist) -gist = gist' Nothing - -- | Query a single gist. -- See gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] --- | Star a gist by the authenticated user. --- --- > starGist (BasicAuth "github-username" "github-password") "225074" -starGist :: Auth -> Name Gist -> IO (Either Error ()) -starGist auth gid = executeRequest auth $ starGistR gid - -- | Star a gist by the authenticated user. -- See starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty --- | Unstar a gist by the authenticated user. --- --- > unstarGist (BasicAuth "github-username" "github-password") "225074" -unstarGist :: Auth -> Name Gist -> IO (Either Error ()) -unstarGist auth gid = executeRequest auth $ unstarGistR gid - -- | Unstar a gist by the authenticated user. -- See unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty --- | Delete a gist by the authenticated user. --- --- > deleteGist (BasicAuth "github-username" "github-password") "225074" -deleteGist :: Auth -> Name Gist -> IO (Either Error ()) -deleteGist auth gid = executeRequest auth $ deleteGistR gid - -- | Delete a gist by the authenticated user. -- See deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 98da18c2..d6a127dd 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -6,38 +6,21 @@ -- The loving comments people have left on Gists, described on -- . module GitHub.Endpoints.Gists.Comments ( - commentsOn, commentsOnR, - comment, gistCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the comments on a Gist, given the Gist ID. --- --- > commentsOn "1174060" -commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) -commentsOn gid = - executeRequest' $ commentsOnR gid FetchAll - -- | List comments on a gist. -- See commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = pagedQuery ["gists", toPathPart gid, "comments"] [] --- | A specific comment, by the comment ID. --- --- > comment (Id 62449) -comment :: Id GistComment -> IO (Either Error GistComment) -comment cid = - executeRequest' $ gistCommentR cid - -- | Query a single comment. -- See gistCommentR :: Id GistComment -> Request k GistComment diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 1de49084..4c3c5f88 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -6,30 +6,13 @@ -- The API for dealing with git blobs from Github repos, as described in -- . module GitHub.Endpoints.GitData.Blobs ( - blob, - blob', blobR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Query a blob by SHA1. --- --- > blob' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) -blob' auth user repo sha = - executeRequestMaybe auth $ blobR user repo sha - --- | Query a blob by SHA1. --- --- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) -blob = blob' Nothing - -- | Query a blob. -- See blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 1d8ced18..109ca87d 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -6,23 +6,13 @@ -- The API for underlying git commits of a Github repo, as described on -- . module GitHub.Endpoints.GitData.Commits ( - commit, gitCommitR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A single commit, by SHA1. --- --- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) -commit user repo sha = - executeRequest' $ gitCommitR user repo sha - -- | Query a commit. -- See gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index ba5e7bc8..270d8805 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -7,79 +7,35 @@ -- 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, + namespacedReferencesR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A single reference by the ref name. --- --- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" -reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) -reference' auth user repo ref = - executeRequestMaybe auth $ referenceR user repo ref - --- | A single reference by the ref name. --- --- > reference "mike-burns" "github" "heads/master" -reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) -reference = reference' Nothing - --- | Query a reference. +-- | A single reference -- | Query a reference. -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) -references' auth user repo = - executeRequestMaybe auth $ referencesR user repo FetchAll - --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) -references = references' Nothing - -- | Query all References. -- See referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] --- | Create a reference. -createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) -createReference auth user repo newRef = - executeRequest auth $ createReferenceR user repo newRef - -- | Create a reference. -- See createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) --- | Limited references by a namespace. --- --- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: Name Owner -> Name Repo -> Text -> IO (Either Error [GitReference]) -namespacedReferences user repo namespace = - executeRequest' $ namespacedReferencesR user repo namespace - -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index b6bc550a..434d8e95 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -6,52 +6,21 @@ -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module GitHub.Endpoints.GitData.Trees ( - tree, - tree', treeR, - nestedTree, - nestedTree', nestedTreeR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A tree for a SHA1. --- --- > tree (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -tree' auth user repo sha = - executeRequestMaybe auth $ treeR user repo sha - --- | A tree for a SHA1. --- --- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -tree = tree' Nothing - -- | Query a Tree. -- See treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] --- | A recursively-nested tree for a SHA1. --- --- > nestedTree' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -nestedTree' auth user repo sha = - executeRequestMaybe auth $ nestedTreeR user repo sha - --- | A recursively-nested tree for a SHA1. --- --- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -nestedTree = nestedTree' Nothing - -- | Query a Tree Recursively. -- See nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 92e73bbc..d2b24e69 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -8,16 +8,10 @@ module GitHub.Endpoints.Issues ( currentUserIssuesR, organizationIssuesR, - issue, - issue', issueR, - issuesForRepo, - issuesForRepo', issuesForRepoR, - createIssue, createIssueR, newIssue, - editIssue, editIssueR, editOfIssue, module GitHub.Data, @@ -25,7 +19,6 @@ module GitHub.Endpoints.Issues ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -- | See . @@ -38,42 +31,12 @@ organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k organizationIssuesR org opts = pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) --- | Details on a specific issue, given the repo owner and name, and the issue --- number.' --- --- > issue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "462" -issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) -issue' auth user reqRepoName reqIssueNumber = - executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber - --- | Details on a specific issue, given the repo owner and name, and the issue --- number. --- --- > issue "thoughtbot" "paperclip" (Id "462") -issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) -issue = issue' Nothing - -- | Query a single issue. -- See issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue issueR user reqRepoName reqIssueNumber = query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the 'IssueRepoMod' data type. --- --- > issuesForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) -issuesForRepo' auth user reqRepoName opts = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll - --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the 'IssueRepoMod' data type. --- --- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) -issuesForRepo = issuesForRepo' Nothing - -- | List issues for a repository. -- See issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) @@ -87,16 +50,6 @@ issuesForRepoR user reqRepoName opts = newIssue :: Text -> NewIssue newIssue title = NewIssue title Nothing mempty Nothing Nothing - --- | Create a new issue. --- --- > createIssue (BasicAuth "github-username" "github-password") user repo --- > (newIssue "some_repo") {...} -createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue - -> IO (Either Error Issue) -createIssue auth user repo ni = - executeRequest auth $ createIssueR user repo ni - -- | Create an issue. -- See createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue @@ -108,15 +61,6 @@ createIssueR user repo = editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing --- | Edit an issue. --- --- > editIssue (BasicAuth "github-username" "github-password") user repo issue --- > editOfIssue {...} -editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue - -> IO (Either Error Issue) -editIssue auth user repo iss edit = - executeRequest auth $ editIssueR user repo iss edit - -- | Edit an issue. -- See editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 0968022b..18550abc 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -6,66 +6,30 @@ -- The Github issue comments API from -- . module GitHub.Endpoints.Issues.Comments ( - comment, commentR, - comments, commentsR, - comments', - createComment, createCommentR, - deleteComment, deleteCommentR, - editComment, editCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A specific comment, by ID. --- --- > comment "thoughtbot" "paperclip" 1468184 -comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) -comment user repo cid = - executeRequest' $ commentR user repo cid - -- | Query a single comment. -- See commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] --- | All comments on an issue, by the issue's number. --- --- > comments "thoughtbot" "paperclip" 635 -comments :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) -comments = comments' Nothing - --- | All comments on an issue, by the issue's number, using authentication. --- --- > comments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 635 -comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) -comments' auth user repo iid = - executeRequestMaybe auth $ commentsR user repo iid FetchAll - -- | List comments on an issue. -- See commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] --- | Create a new comment. --- --- > createComment (BasicAuth "github-username" "github-password") user repo issue --- > "some words" -createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text - -> IO (Either Error Comment) -createComment auth user repo iss body = - executeRequest auth $ createCommentR user repo iss body - -- | Create a comment. -- See createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment @@ -74,15 +38,6 @@ createCommentR user repo iss body = where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] --- | Edit a comment. --- --- > editComment (BasicAuth "github-username" "github-password") user repo commentid --- > "new words" -editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text - -> IO (Either Error Comment) -editComment auth user repo commid body = - executeRequest auth $ editCommentR user repo commid body - -- | Edit a comment. -- See editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment @@ -91,14 +46,6 @@ editCommentR user repo commid body = where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] --- | Delete a comment. --- --- > deleteComment (BasicAuth "github-username" "github-password") user repo commentid -deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment - -> IO (Either Error ()) -deleteComment auth user repo commid = - executeRequest auth $ deleteCommentR user repo commid - -- | Delete a comment. -- See deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index c139f819..e69ed9fa 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -6,74 +6,28 @@ -- The Github issue events API, which is described on -- module GitHub.Endpoints.Issues.Events ( - eventsForIssue, - eventsForIssue', eventsForIssueR, - eventsForRepo, - eventsForRepo', eventsForRepoR, - event, - event', eventR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All events that have happened on an issue. --- --- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) -eventsForIssue = eventsForIssue' Nothing - --- | All events that have happened on an issue, using authentication. --- --- > eventsForIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) -eventsForIssue' auth user repo iid = - executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll - -- | List events for an issue. -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueEvent) eventsForIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] --- | All the events for all issues in a repo. --- --- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) -eventsForRepo = eventsForRepo' Nothing - --- | All the events for all issues in a repo, using authentication. --- --- > eventsForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) -eventsForRepo' auth user repo = - executeRequestMaybe auth $ eventsForRepoR user repo FetchAll - -- | List events for a repository. -- See eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueEvent) eventsForRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] --- | Details on a specific event, by the event's ID. --- --- > event "thoughtbot" "paperclip" 5335772 -event :: Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) -event = event' Nothing - --- | Details on a specific event, by the event's ID, using authentication. --- --- > event' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 5335772 -event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) -event' auth user repo eid = - executeRequestMaybe auth $ eventR user repo eid - -- | Query a single event. -- See eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 81affd8a..cb80992e 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -6,85 +6,36 @@ -- The API for dealing with labels on Github issues as described on -- . module GitHub.Endpoints.Issues.Labels ( - labelsOnRepo, - labelsOnRepo', labelsOnRepoR, - label, - label', labelR, - createLabel, createLabelR, - updateLabel, updateLabelR, - deleteLabel, deleteLabelR, - labelsOnIssue, - labelsOnIssue', labelsOnIssueR, - addLabelsToIssue, addLabelsToIssueR, - removeLabelFromIssue, removeLabelFromIssueR, - replaceAllLabelsForIssue, replaceAllLabelsForIssueR, - removeAllLabelsFromIssue, removeAllLabelsFromIssueR, - labelsOnMilestone, - labelsOnMilestone', labelsOnMilestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the labels available to use on any issue in the repo. --- --- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) -labelsOnRepo = labelsOnRepo' Nothing - --- | All the labels available to use on any issue in the repo using authentication. --- --- > labelsOnRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) -labelsOnRepo' auth user repo = - executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll - -- | List all labels for this repository. -- See labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] --- | A label by name. --- --- > label "thoughtbot" "paperclip" "bug" -label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) -label = label' Nothing - --- | A label by name using authentication. --- --- > label' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" -label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) -label' auth user repo lbl = - executeRequestMaybe auth $ labelR user repo lbl - -- | Query a single label. -- See labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] --- | Create a label --- --- > createLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "f29513" -createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) -createLabel auth user repo lbl color = - executeRequest auth $ createLabelR user repo lbl color - -- | Create a label. -- See createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel @@ -94,19 +45,6 @@ createLabelR user repo lbl color = paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] --- | Update a label --- --- > updateLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" -updateLabel :: Auth - -> Name Owner - -> Name Repo - -> Name IssueLabel -- ^ old label name - -> Name IssueLabel -- ^ new label name - -> String -- ^ new color - -> IO (Either Error IssueLabel) -updateLabel auth user repo oldLbl newLbl color = - executeRequest auth $ updateLabelR user repo oldLbl newLbl color - -- | Update a label. -- See updateLabelR :: Name Owner @@ -121,51 +59,18 @@ updateLabelR user repo oldLbl newLbl color = paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] --- | Delete a label --- --- > deleteLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" -deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) -deleteLabel auth user repo lbl = - executeRequest auth $ deleteLabelR user repo lbl - -- | Delete a label. -- See deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> GenRequest 'MtUnit 'RW () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty --- | The labels on an issue in a repo. --- --- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) -labelsOnIssue = labelsOnIssue' Nothing - --- | The labels on an issue in a repo using authentication. --- --- > labelsOnIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) -labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) -labelsOnIssue' auth user repo iid = - executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll - -- | List labels on an issue. -- See labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] --- | Add labels to an issue. --- --- > addLabelsToIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] -addLabelsToIssue :: Foldable f - => Auth - -> Name Owner - -> Name Repo - -> Id Issue - -> f (Name IssueLabel) - -> IO (Either Error (Vector IssueLabel)) -addLabelsToIssue auth user repo iid lbls = - executeRequest auth $ addLabelsToIssueR user repo iid lbls - -- | Add lables to an issue. -- See addLabelsToIssueR :: Foldable f @@ -179,32 +84,12 @@ addLabelsToIssueR user repo iid lbls = where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] --- | Remove a label from an issue. --- --- > removeLabelFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) "bug" -removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) -removeLabelFromIssue auth user repo iid lbl = - executeRequest auth $ removeLabelFromIssueR user repo iid lbl - -- | Remove a label from an issue. -- See removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () removeLabelFromIssueR user repo iid lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty --- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. --- --- > replaceAllLabelsForIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] -replaceAllLabelsForIssue :: Foldable f - => Auth - -> Name Owner - -> Name Repo - -> Id Issue - -> f (Name IssueLabel) - -> IO (Either Error (Vector IssueLabel)) -replaceAllLabelsForIssue auth user repo iid lbls = - executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls - -- | Replace all labels on an issue. -- See -- @@ -220,32 +105,12 @@ replaceAllLabelsForIssueR user repo iid lbls = where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] --- | Remove all labels from an issue. --- --- > removeAllLabelsFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) -removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ()) -removeAllLabelsFromIssue auth user repo iid = - executeRequest auth $ removeAllLabelsFromIssueR user repo iid - -- | Remove all labels from an issue. -- See removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty --- | All the labels on a repo's milestone given the milestone ID. --- --- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) -labelsOnMilestone = labelsOnMilestone' Nothing - --- | All the labels on a repo's milestone given the milestone ID using authentication. --- --- > labelsOnMilestone' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) -labelsOnMilestone' auth user repo mid = - executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll - -- | Query labels for every issue in a milestone. -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 574d2a0e..78b6531d 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -6,78 +6,42 @@ -- The milestones API as described on -- . module GitHub.Endpoints.Issues.Milestones ( - milestones, - milestones', milestonesR, - milestone, milestoneR, - createMilestone, createMilestoneR, - updateMilestone, updateMilestoneR, - deleteMilestone, deleteMilestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All milestones in the repo. --- --- > milestones "thoughtbot" "paperclip" -milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) -milestones = milestones' Nothing - --- | All milestones in the repo, using authentication. --- --- > milestones' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) -milestones' auth user repo = - executeRequestMaybe auth $ milestonesR user repo FetchAll - -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) milestonesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] --- | Details on a specific milestone, given it's milestone number. --- --- > milestone "thoughtbot" "paperclip" (Id 2) -milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) -milestone user repo mid = - executeRequest' $ milestoneR user repo mid - -- | Query a single milestone. -- See milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] -createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) -createMilestone auth user repo mlstn = executeRequest auth $ createMilestoneR user repo mlstn - -- | Create a milestone. -- See createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Milestone createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode -updateMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> IO (Either Error Milestone) -updateMilestone auth user repo mid mlstn = executeRequest auth $ updateMilestoneR user repo mid mlstn - -- | Update a milestone. -- See updateMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> Request 'RW Milestone updateMilestoneR user repo mid = command Patch ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid ] . encode -deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) -deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid - -- | Delete a milestone. -- See deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index ee1f5557..12844510 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -5,11 +5,7 @@ -- -- The orgs API as described on . module GitHub.Endpoints.Organizations ( - publicOrganizationsFor, - publicOrganizationsFor', publicOrganizationsForR, - publicOrganization, - publicOrganization', publicOrganizationR, organizationsR, module GitHub.Data, @@ -17,22 +13,8 @@ module GitHub.Endpoints.Organizations ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The public organizations for a user, given the user's login, with authorization --- --- > publicOrganizationsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" -publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) -publicOrganizationsFor' auth org = - executeRequestMaybe auth $ publicOrganizationsForR org FetchAll - --- | List user organizations. The public organizations for a user, given the user's login. --- --- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) -publicOrganizationsFor = publicOrganizationsFor' Nothing - -- | List all user organizations. -- See organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) @@ -43,18 +25,6 @@ organizationsR = pagedQuery ["user", "orgs"] [] publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] --- | Details on a public organization. Takes the organization's login. --- --- > publicOrganization' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" -publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) -publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR - --- | Query an organization. Details on a public organization. Takes the organization's login. --- --- > publicOrganization "thoughtbot" -publicOrganization :: Name Organization -> IO (Either Error Organization) -publicOrganization = publicOrganization' Nothing - -- | Query an organization. -- See publicOrganizationR :: Name Organization -> Request k Organization diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index db952269..26a8f4c4 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -6,12 +6,8 @@ -- The organization members API as described on -- . module GitHub.Endpoints.Organizations.Members ( - membersOf, - membersOf', membersOfR, membersOfWithR, - isMemberOf, - isMemberOf', isMemberOfR, orgInvitationsR, module GitHub.Data, @@ -19,24 +15,8 @@ module GitHub.Endpoints.Organizations.Members ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the users who are members of the specified organization, --- | with or without authentication. --- --- > membersOf' (Just $ OAuth "token") "thoughtbot" -membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) -membersOf' auth org = - executeRequestMaybe auth $ membersOfR org FetchAll - --- | All the users who are members of the specified organization, --- | without authentication. --- --- > membersOf "thoughtbot" -membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) -membersOf = membersOf' Nothing - -- | All the users who are members of the specified organization. -- -- See @@ -59,21 +39,6 @@ membersOfWithR org f r = OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" --- | Check if a user is a member of an organization, --- | with or without authentication. --- --- > isMemberOf' (Just $ OAuth "token") "phadej" "haskell-infra" -isMemberOf' :: Maybe Auth -> Name User -> Name Organization -> IO (Either Error Bool) -isMemberOf' auth user org = - executeRequestMaybe auth $ isMemberOfR user org - --- | Check if a user is a member of an organization, --- | without authentication. --- --- > isMemberOf "phadej" "haskell-infra" -isMemberOf :: Name User -> Name Organization -> IO (Either Error Bool) -isMemberOf = isMemberOf' Nothing - -- | Check if a user is a member of an organization. -- -- See diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 3aa19401..189e68f7 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -6,122 +6,49 @@ -- The Owner teams API as described on -- . module GitHub.Endpoints.Organizations.Teams ( - teamsOf, - teamsOf', teamsOfR, - teamInfoFor, - teamInfoFor', teamInfoForR, - createTeamFor', createTeamForR, - editTeam', editTeamR, - deleteTeam', deleteTeamR, listTeamMembersR, - listTeamRepos, - listTeamRepos', listTeamReposR, - addOrUpdateTeamRepo', addOrUpdateTeamRepoR, - teamMembershipInfoFor, - teamMembershipInfoFor', teamMembershipInfoForR, - addTeamMembershipFor', addTeamMembershipForR, - deleteTeamMembershipFor', deleteTeamMembershipForR, - listTeamsCurrent', listTeamsCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | List teams. List the teams of an Owner. --- When authenticated, lists private teams visible to the authenticated user. --- When unauthenticated, lists only public teams for an Owner. --- --- > teamsOf' (Just $ OAuth "token") "thoughtbot" -teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) -teamsOf' auth org = - executeRequestMaybe auth $ teamsOfR org FetchAll - --- | List the public teams of an Owner. --- --- > teamsOf "thoughtbot" -teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) -teamsOf = teamsOf' Nothing - -- | List teams. -- See teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) teamsOfR org = pagedQuery ["orgs", toPathPart org, "teams"] [] --- | The information for a single team, by team id. --- With authentication --- --- > teamInfoFor' (Just $ OAuth "token") 1010101 -teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) -teamInfoFor' auth tid = - executeRequestMaybe auth $ teamInfoForR tid - --- | The information for a single team, by team id. --- --- > teamInfoFor' (Just $ OAuth "token") 1010101 -teamInfoFor :: Id Team -> IO (Either Error Team) -teamInfoFor = teamInfoFor' Nothing - -- | Query team. -- See teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = query ["teams", toPathPart tid] [] --- | Create a team under an Owner --- --- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull) -createTeamFor' :: Auth - -> Name Organization - -> CreateTeam - -> IO (Either Error Team) -createTeamFor' auth org cteam = - executeRequest auth $ createTeamForR org cteam - -- | Create team. -- See createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = command Post ["orgs", toPathPart org, "teams"] (encode cteam) --- | Edit a team, by id. --- --- > editTeamFor' -editTeam' :: Auth - -> Id Team - -> EditTeam - -> IO (Either Error Team) -editTeam' auth tid eteam = - executeRequest auth $ editTeamR tid eteam - -- | Edit team. -- See editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = command Patch ["teams", toPathPart tid] (encode eteam) --- | Delete a team, by id. --- --- > deleteTeam' (OAuth "token") 1010101 -deleteTeam' :: Auth -> Id Team -> IO (Either Error ()) -deleteTeam' auth tid = - executeRequest auth $ deleteTeamR tid - --- | Delete team. -- -- See deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () @@ -140,90 +67,36 @@ listTeamMembersR tid r = TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" --- | The repositories of a single team, by team id. --- With authentication --- --- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) -listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll - -- | Query team repositories. -- See listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) listTeamReposR tid = pagedQuery ["teams", toPathPart tid, "repos"] [] --- | Retrieve repositories for a team. --- --- > listTeamRepos (GitHub.mkTeamId team_id) -listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos = listTeamRepos' Nothing - --- | Add a repository to a team or update the permission on the repository. --- --- > addOrUpdateTeamRepo' (OAuth "token") 1010101 "mburns" (Just PermissionPull) -addOrUpdateTeamRepo' :: Auth -> Id Team -> Name Organization -> Name Repo -> Permission -> IO (Either Error ()) -addOrUpdateTeamRepo' auth tid org repo permission = - executeRequest auth $ addOrUpdateTeamRepoR tid org repo permission - -- | Add or update a team repository. -- See addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> GenRequest 'MtUnit 'RW () addOrUpdateTeamRepoR tid org repo permission = Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) --- | Retrieve team mebership information for a user. --- With authentication --- --- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns" -teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership) -teamMembershipInfoFor' auth tid user = - executeRequestMaybe auth $ teamMembershipInfoForR tid user - -- | Query team membership. -- See Name Owner -> Request k TeamMembership teamMembershipInfoForR tid user = query ["teams", toPathPart tid, "memberships", toPathPart user] [] --- | Retrieve team mebership information for a user. --- --- > teamMembershipInfoFor 1010101 "mburns" -teamMembershipInfoFor :: Id Team -> Name Owner -> IO (Either Error TeamMembership) -teamMembershipInfoFor = teamMembershipInfoFor' Nothing - --- | Add (or invite) a member to a team. --- --- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember -addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role -> IO (Either Error TeamMembership) -addTeamMembershipFor' auth tid user role = - executeRequest auth $ addTeamMembershipForR tid user role - -- | Add team membership. -- See addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) --- | Delete a member of a team. --- --- > deleteTeamMembershipFor' (OAuth "token") 1010101 "mburns" -deleteTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> IO (Either Error ()) -deleteTeamMembershipFor' auth tid user = - executeRequest auth $ deleteTeamMembershipForR tid user - -- | Remove team membership. -- See deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty --- | List teams for current authenticated user --- --- > listTeamsCurrent' (OAuth "token") -listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) -listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll - -- | List user teams. -- See listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 88409839..7217e51b 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -6,55 +6,24 @@ -- The pull requests API as documented at -- . module GitHub.Endpoints.PullRequests ( - pullRequestsFor, - pullRequestsFor', pullRequestsForR, - pullRequest', - pullRequest, pullRequestR, - pullRequestDiff', - pullRequestDiff, pullRequestDiffR, - pullRequestPatch', - pullRequestPatch, pullRequestPatchR, - createPullRequest, createPullRequestR, - updatePullRequest, updatePullRequestR, - pullRequestCommits', - pullRequestCommitsIO, pullRequestCommitsR, - pullRequestFiles', - pullRequestFiles, pullRequestFilesR, - isPullRequestMerged, isPullRequestMergedR, - mergePullRequest, mergePullRequestR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import Data.ByteString.Lazy (ByteString) --- | All open pull requests for the repo, by owner and repo name. --- --- > pullRequestsFor "rails" "rails" -pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo mempty FetchAll - --- | All open pull requests for the repo, by owner and repo name. --- --- > pullRequestsFor "rails" "rails" -pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor' auth user repo = - executeRequestMaybe auth $ pullRequestsForR user repo mempty FetchAll - -- | List pull requests. -- See pullRequestsForR @@ -67,71 +36,24 @@ pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) --- | Obtain the diff of a pull request --- See -pullRequestDiff' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestDiff' auth user repo prid = - executeRequestMaybe auth $ pullRequestDiffR user repo prid - --- | Obtain the diff of a pull request --- See -pullRequestDiff :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestDiff = pullRequestDiff' Nothing - -- | Query a single pull request to obtain the diff -- See pullRequestDiffR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtDiff rw ByteString pullRequestDiffR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] --- | Obtain the patch of a pull request --- --- See -pullRequestPatch' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestPatch' auth user repo prid = - executeRequestMaybe auth $ pullRequestPatchR user repo prid - --- | Obtain the patch of a pull request --- See -pullRequestPatch :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestPatch = pullRequestPatch' Nothing - -- | Query a single pull request to obtain the patch -- See pullRequestPatchR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtPatch rw ByteString pullRequestPatchR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] --- | A detailed pull request, which has much more information. This takes the --- repo owner and name along with the number assigned to the pull request. --- With authentification. --- --- > pullRequest' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) -pullRequest' auth user repo prid = - executeRequestMaybe auth $ pullRequestR user repo prid - --- | A detailed pull request, which has much more information. This takes the --- repo owner and name along with the number assigned to the pull request. --- --- > pullRequest "thoughtbot" "paperclip" 562 -pullRequest :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) -pullRequest = pullRequest' Nothing - -- | Query a single pull request. -- See pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest pullRequestR user repo prid = query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] -createPullRequest :: Auth - -> Name Owner - -> Name Repo - -> CreatePullRequest - -> IO (Either Error PullRequest) -createPullRequest auth user repo cpr = - executeRequest auth $ createPullRequestR user repo cpr - -- | Create a pull request. -- See createPullRequestR :: Name Owner @@ -141,11 +63,6 @@ createPullRequestR :: Name Owner createPullRequestR user repo cpr = command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) --- | Update a pull request -updatePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> EditPullRequest -> IO (Either Error PullRequest) -updatePullRequest auth user repo prid epr = - executeRequest auth $ updatePullRequestR user repo prid epr - -- | Update a pull request. -- See updatePullRequestR :: Name Owner @@ -156,66 +73,24 @@ updatePullRequestR :: Name Owner updatePullRequestR user repo prid epr = command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- With authentification. --- --- > pullRequestCommits' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) -pullRequestCommits' auth user repo prid = - executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll - --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- --- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) -pullRequestCommitsIO = pullRequestCommits' Nothing - -- | List commits on a pull request. -- See pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] --- | The individual files that a pull request patches. Takes the repo owner and --- name, plus the number assigned to the pull request. --- With authentification. --- --- > pullRequestFiles' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 -pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) -pullRequestFiles' auth user repo prid = - executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll - --- | The individual files that a pull request patches. Takes the repo owner and --- name, plus the number assigned to the pull request. --- --- > pullRequestFiles "thoughtbot" "paperclip" 688 -pullRequestFiles :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) -pullRequestFiles = pullRequestFiles' Nothing - -- | List pull requests files. -- See pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] --- | Check if pull request has been merged. -isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error Bool) -isPullRequestMerged auth user repo prid = - executeRequest auth $ isPullRequestMergedR user repo prid - -- | Query if a pull request has been merged. -- See isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtStatus rw Bool isPullRequestMergedR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] --- | Merge a pull request. -mergePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> IO (Either Error MergeResult) -mergePullRequest auth user repo prid commitMessage = - executeRequest auth $ mergePullRequestR user repo prid commitMessage - -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 52103030..889de642 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -6,55 +6,28 @@ -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.Comments ( - pullRequestCommentsIO, pullRequestCommentsR, - pullRequestComment, pullRequestCommentR, - createPullComment, createPullCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the comments on a pull request with the given ID. --- --- > pullRequestComments "thoughtbot" "factory_girl" (Id 256) -pullRequestCommentsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Comment)) -pullRequestCommentsIO user repo prid = - executeRequest' $ pullRequestCommentsR user repo prid FetchAll - -- | List comments on a pull request. -- See pullRequestCommentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Comment) pullRequestCommentsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] --- | One comment on a pull request, by the comment's ID. --- --- > pullRequestComment "thoughtbot" "factory_girl" (Id 301819) -pullRequestComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -pullRequestComment user repo cid = - executeRequest' $ pullRequestCommentR user repo cid - -- | Query a single comment. -- See pullRequestCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment pullRequestCommentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] --- | Create a new comment. --- --- > createPullComment (BasicAuth "github-username" "github-password") user repo issue commit path position --- > "some words" -createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text - -> IO (Either Error Comment) -createPullComment auth user repo iss commit path position body = - executeRequest auth $ createPullCommentR user repo iss commit path position body - -- | Create a comment. -- -- See diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index afbc158c..e5c42ac8 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -6,22 +6,14 @@ -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews ( pullRequestReviewsR - , pullRequestReviews - , pullRequestReviews' , pullRequestReviewR - , pullRequestReview - , pullRequestReview' , pullRequestReviewCommentsR - , pullRequestReviewCommentsIO - , pullRequestReviewCommentsIO' , module GitHub.Data ) where import GitHub.Data import GitHub.Data.Id (Id) import GitHub.Internal.Prelude -import GitHub.Request - (Request, executeRequest', executeRequestMaybe) import Prelude () -- | List reviews for a pull request. @@ -43,31 +35,6 @@ pullRequestReviewsR owner repo prid = ] [] --- | All reviews for a pull request given the repo owner, repo name and the pull --- request id. --- --- > pullRequestReviews "thoughtbot" "paperclip" (Id 101) -pullRequestReviews - :: Name Owner - -> Name Repo - -> IssueNumber - -> IO (Either Error (Vector Review)) -pullRequestReviews owner repo prid = - executeRequest' $ pullRequestReviewsR owner repo prid FetchAll - --- | All reviews for a pull request given the repo owner, repo name and the pull --- request id. With authentication. --- --- > pullRequestReviews' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 101) -pullRequestReviews' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> IssueNumber - -> IO (Either Error (Vector Review)) -pullRequestReviews' auth owner repo pr = - executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll - -- | Query a single pull request review. -- see pullRequestReviewR @@ -88,34 +55,6 @@ pullRequestReviewR owner repo prid rid = ] [] --- | A detailed review on a pull request given the repo owner, repo name, pull --- request id and review id. --- --- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) -pullRequestReview - :: Name Owner - -> Name Repo - -> IssueNumber - -> Id Review - -> IO (Either Error Review) -pullRequestReview owner repo prid rid = - executeRequest' $ pullRequestReviewR owner repo prid rid - --- | A detailed review on a pull request given the repo owner, repo name, pull --- request id and review id. With authentication. --- --- > pullRequestReview' (Just $ BasicAuth "github-username" "github-password") --- > "thoughtbot" "factory_girl" (Id 301819) (Id 332) -pullRequestReview' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> IssueNumber - -> Id Review - -> IO (Either Error Review) -pullRequestReview' auth owner repo prid rid = - executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid - -- | Query the comments for a single pull request review. -- see pullRequestReviewCommentsR @@ -136,30 +75,3 @@ pullRequestReviewCommentsR owner repo prid rid = , "comments" ] [] - --- | All comments for a review on a pull request given the repo owner, repo --- name, pull request id and review id. --- --- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) -pullRequestReviewCommentsIO - :: Name Owner - -> Name Repo - -> IssueNumber - -> Id Review - -> IO (Either Error [ReviewComment]) -pullRequestReviewCommentsIO owner repo prid rid = - executeRequest' $ pullRequestReviewCommentsR owner repo prid rid - --- | All comments for a review on a pull request given the repo owner, repo --- name, pull request id and review id. With authentication. --- --- > pullRequestReviewComments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "factory_girl" (Id 301819) (Id 332) -pullRequestReviewCommentsIO' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> IssueNumber - -> Id Review - -> IO (Either Error [ReviewComment]) -pullRequestReviewCommentsIO' auth owner repo prid rid = - executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs index d357fbe8..3bbe8c2f 100644 --- a/src/GitHub/Endpoints/RateLimit.hs +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -7,26 +7,12 @@ -- . module GitHub.Endpoints.RateLimit ( rateLimitR, - rateLimit, - rateLimit', module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) --- With authentication. -rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) -rateLimit' auth = executeRequestMaybe auth rateLimitR - --- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) --- Without authentication. -rateLimit :: IO (Either Error RateLimit) -rateLimit = rateLimit' Nothing - -- | Get your current rate limit status. -- rateLimitR :: Request k RateLimit diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 921204d5..38fe1e6f 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -7,46 +7,24 @@ -- module GitHub.Endpoints.Repos ( -- * Querying repositories - currentUserRepos, currentUserReposR, - userRepos, - userRepos', userReposR, - organizationRepos, - organizationRepos', organizationReposR, - repository, - repository', repositoryR, - contributors, - contributors', contributorsR, - contributorsWithAnonymous, - contributorsWithAnonymous', - languagesFor, - languagesFor', languagesForR, - tagsFor, - tagsFor', tagsForR, - branchesFor, - branchesFor', branchesForR, -- ** Create - createRepo', createRepoR, - createOrganizationRepo', createOrganizationRepoR, - forkExistingRepo', forkExistingRepoR, -- ** Edit - editRepo, editRepoR, -- ** Delete - deleteRepo, deleteRepoR, -- * Data @@ -55,7 +33,6 @@ module GitHub.Endpoints.Repos ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString @@ -65,11 +42,6 @@ repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] --- | List your repositories. -currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) -currentUserRepos auth publicity = - executeRequest auth $ currentUserReposR publicity FetchAll - -- | List your repositories. -- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) @@ -78,25 +50,6 @@ currentUserReposR publicity = where qs = repoPublicityQueryString publicity --- | The repos for a user, by their login. Can be restricted to just repos they --- own, are a member of, or publicize. Private repos will return empty list. --- --- > userRepos "mike-burns" All -userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) -userRepos = userRepos' Nothing - --- | The repos for a user, by their login. --- With authentication. --- --- > userRepos' (Just $ BasicAuth "github-username" "github-password") "mike-burns" All -userRepos' - :: Maybe Auth - -> Name Owner - -> RepoPublicity - -> IO (Either Error (Vector Repo)) -userRepos' auth user publicity = - executeRequestMaybe auth $ userReposR user publicity FetchAll - -- | List user repositories. -- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) @@ -105,24 +58,6 @@ userReposR user publicity = where qs = repoPublicityQueryString publicity --- | The repos for an organization, by the organization name. --- --- > organizationRepos "thoughtbot" -organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) -organizationRepos org = organizationRepos' Nothing org RepoPublicityAll - --- | The repos for an organization, by the organization name. --- With authentication. --- --- > organizationRepos (Just $ BasicAuth "github-username" "github-password") "thoughtbot" All -organizationRepos' - :: Maybe Auth - -> Name Organization - -> RepoPublicity - -> IO (Either Error (Vector Repo)) -organizationRepos' auth org publicity = - executeRequestMaybe auth $ organizationReposR org publicity FetchAll - -- | List organization repositories. -- See organizationReposR @@ -135,44 +70,18 @@ organizationReposR org publicity = where qs = repoPublicityQueryString publicity --- | Details on a specific repo, given the owner and repo name. --- --- > repository "mike-burns" "github" -repository :: Name Owner -> Name Repo -> IO (Either Error Repo) -repository = repository' Nothing - --- | Details on a specific repo, given the owner and repo name. --- With authentication. --- --- > repository' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" -repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) -repository' auth user repo = - executeRequestMaybe auth $ repositoryR user repo - -- | Query single repository. -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = query ["repos", toPathPart user, toPathPart repo] [] --- | Create a new repository. --- --- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} -createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) -createRepo' auth nrepo = - executeRequest auth $ createRepoR nrepo - -- | Create a new repository. -- See createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) --- | Fork an existing repository. -forkExistingRepo' :: Auth -> Name Owner -> Name Repo -> Maybe (Name Owner) -> IO (Either Error Repo) -forkExistingRepo' auth owner repo morg = - executeRequest auth $ forkExistingRepoR owner repo morg - -- | Fork an existing repository. -- See -- TODO: The third paramater (an optional Organisation) is not used yet. @@ -180,32 +89,12 @@ forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'R forkExistingRepoR owner repo _morg = command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty --- | Create a new repository for an organization. --- --- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} -createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) -createOrganizationRepo' auth org nrepo = - executeRequest auth $ createOrganizationRepoR org nrepo - -- | Create a new repository for an organization. -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = command Post ["orgs", toPathPart org, "repos"] (encode nrepo) --- | Edit an existing repository. --- --- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo - :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> EditRepo - -> IO (Either Error Repo) -editRepo auth user repo body = - executeRequest auth $ editRepoR user repo body - - -- | Edit an existing repository. -- See editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo @@ -215,20 +104,6 @@ editRepoR user repo body = -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} --- | The contributors to a repo, given the owner and repo name. --- --- > contributors "thoughtbot" "paperclip" -contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributors = contributors' Nothing - --- | The contributors to a repo, given the owner and repo name. --- With authentication. --- --- > contributors' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributors' auth user repo = - executeRequestMaybe auth $ contributorsR user repo False FetchAll - -- | List contributors. -- See contributorsR @@ -243,93 +118,24 @@ contributorsR user repo anon = qs | anon = [("anon", Just "true")] | otherwise = [] --- | The contributors to a repo, including anonymous contributors (such as --- deleted users or git commits with unknown email addresses), given the owner --- and repo name. --- --- > contributorsWithAnonymous "thoughtbot" "paperclip" -contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributorsWithAnonymous = contributorsWithAnonymous' Nothing - --- | The contributors to a repo, including anonymous contributors (such as --- deleted users or git commits with unknown email addresses), given the owner --- and repo name. --- With authentication. --- --- > contributorsWithAnonymous' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributorsWithAnonymous' auth user repo = - executeRequestMaybe auth $ contributorsR user repo True FetchAll - --- | The programming languages used in a repo along with the number of --- characters written in that language. Takes the repo owner and name. --- --- > languagesFor "mike-burns" "ohlaunch" -languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) -languagesFor = languagesFor' Nothing - --- | The programming languages used in a repo along with the number of --- characters written in that language. Takes the repo owner and name. --- With authentication. --- --- > languagesFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "ohlaunch" -languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) -languagesFor' auth user repo = - executeRequestMaybe auth $ languagesForR user repo - -- | List languages. -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = query ["repos", toPathPart user, toPathPart repo, "languages"] [] --- | The git tags on a repo, given the repo owner and name. --- --- > tagsFor "thoughtbot" "paperclip" -tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) -tagsFor = tagsFor' Nothing - --- | The git tags on a repo, given the repo owner and name. --- With authentication. --- --- > tagsFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) -tagsFor' auth user repo = - executeRequestMaybe auth $ tagsForR user repo FetchAll - -- | List tags. -- See tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] --- | The git branches on a repo, given the repo owner and name. --- --- > branchesFor "thoughtbot" "paperclip" -branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) -branchesFor = branchesFor' Nothing - --- | The git branches on a repo, given the repo owner and name. --- With authentication. --- --- > branchesFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) -branchesFor' auth user repo = - executeRequestMaybe auth $ branchesForR user repo FetchAll - -- | List branches. -- See branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] --- | Delete an existing repository. --- --- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" -deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) -deleteRepo auth user repo = - executeRequest auth $ deleteRepoR user repo - -- | Delete a repository,. -- See deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index ac0d9c0e..bc5680c6 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -6,53 +6,22 @@ -- The repo collaborators API as described on -- . module GitHub.Endpoints.Repos.Collaborators ( - collaboratorsOn, - collaboratorsOn', collaboratorsOnR, - isCollaboratorOn, isCollaboratorOnR, - addCollaborator, addCollaboratorR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the users who have collaborated on a repo. --- --- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -collaboratorsOn = collaboratorsOn' Nothing - --- | All the users who have collaborated on a repo. --- With authentication. -collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -collaboratorsOn' auth user repo = - executeRequestMaybe auth $ collaboratorsOnR user repo FetchAll - -- | List collaborators. -- See collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] --- | Whether the user is collaborating on a repo. Takes the user in question, --- the user who owns the repo, and the repo name. --- --- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" --- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" -isCollaboratorOn - :: Maybe Auth - -> Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator? - -> IO (Either Error Bool) -isCollaboratorOn auth user repo coll = - executeRequestMaybe auth $ isCollaboratorOnR user repo coll - -- | Check if a user is a collaborator. -- See isCollaboratorOnR @@ -63,15 +32,6 @@ isCollaboratorOnR isCollaboratorOnR user repo coll = Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] -addCollaborator - :: Auth - -> Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator to add - -> IO (Either Error (Maybe RepoInvitation)) -addCollaborator auth owner repo coll = - executeRequest auth $ addCollaboratorR owner repo coll - -- | Invite a user as a collaborator. -- See addCollaboratorR diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 5adcf814..2b853c0e 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -7,76 +7,28 @@ -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Comments ( - commentsFor, - commentsFor', commentsForR, - commitCommentsFor, - commitCommentsFor', commitCommentsForR, - commitCommentFor, - commitCommentFor', commitCommentForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the comments on a Github repo. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) -commentsFor = commentsFor' Nothing - --- | All the comments on a Github repo. --- With authentication. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) -commentsFor' auth user repo = - executeRequestMaybe auth $ commentsForR user repo FetchAll - -- | List commit comments for a repository. -- See commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] --- | Just the comments on a specific SHA for a given Github repo. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) -commitCommentsFor = commitCommentsFor' Nothing - --- | Just the comments on a specific SHA for a given Github repo. --- With authentication. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) -commitCommentsFor' auth user repo sha = - executeRequestMaybe auth $ commitCommentsForR user repo sha FetchAll - -- | List comments for a single commit. -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -commitCommentFor = commitCommentFor' Nothing - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -commitCommentFor' auth user repo cid = - executeRequestMaybe auth $ commitCommentForR user repo cid - -- | Query a single commit comment. -- See commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index affa5044..bfe0cc84 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -8,24 +8,15 @@ -- . module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), - commitsFor, - commitsFor', commitsForR, - commitsWithOptionsFor, - commitsWithOptionsFor', commitsWithOptionsForR, - commit, - commit', commitR, - diff, - diff', diffR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import qualified Data.ByteString as BS @@ -39,37 +30,11 @@ renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encode renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) --- | The commit history for a repo. --- --- > commitsFor "mike-burns" "github" -commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) -commitsFor = commitsFor' Nothing - --- | The commit history for a repo. --- With authentication. --- --- > commitsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" -commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) -commitsFor' auth user repo = - commitsWithOptionsFor' auth user repo [] - -- | List commits on a repository. -- See commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] -commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) -commitsWithOptionsFor = commitsWithOptionsFor' Nothing - --- | The commit history for a repo, with commits filtered to satisfy a list of --- query options. --- With authentication. --- --- > commitsWithOptionsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" [CommitQueryAuthor "djeik"] -commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) -commitsWithOptionsFor' auth user repo opts = - executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts - -- | List commits on a repository. -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) @@ -78,40 +43,12 @@ commitsWithOptionsForR user repo limit opts = where qs = map renderCommitQueryOption opts - --- | Details on a specific SHA1 for a repo. --- --- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) -commit = commit' Nothing - --- | Details on a specific SHA1 for a repo. --- With authentication. --- --- > commit (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) -commit' auth user repo sha = - executeRequestMaybe auth $ commitR user repo sha - -- | Query a single commit. -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) -diff = diff' Nothing - --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) -diff' auth user repo base headref = - executeRequestMaybe auth $ diffR user repo base headref - -- | Compare two commits. -- See diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index bc5a9ab6..55f48c99 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -7,26 +7,17 @@ -- module GitHub.Endpoints.Repos.Contents ( -- * Querying contents - contentsFor, - contentsFor', contentsForR, - readmeFor, - readmeFor', readmeForR, - archiveFor, - archiveFor', archiveForR, -- ** Create - createFile, createFileR, -- ** Update - updateFile, updateFileR, -- ** Delete - deleteFile, deleteFileR, module GitHub.Data @@ -34,27 +25,12 @@ module GitHub.Endpoints.Repos.Contents ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import Data.Maybe (maybeToList) import qualified Data.Text.Encoding as TE import Network.URI (URI) --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- --- > contentsFor "thoughtbot" "paperclip" "README.md" -contentsFor :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) -contentsFor = contentsFor' Nothing - --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- With Authentication --- --- > contentsFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "README.md" Nothing -contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) -contentsFor' auth user repo path ref = - executeRequestMaybe auth $ contentsForR user repo path ref - contentsForR :: Name Owner -> Name Repo @@ -66,38 +42,10 @@ contentsForR user repo path ref = where qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref --- | The contents of a README file in a repo, given the repo owner and name --- --- > readmeFor "thoughtbot" "paperclip" -readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor = readmeFor' Nothing - --- | The contents of a README file in a repo, given the repo owner and name --- With Authentication --- --- > readmeFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor' auth user repo = - executeRequestMaybe auth $ readmeForR user repo - readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = query ["repos", toPathPart user, toPathPart repo, "readme"] [] --- | The archive of a repo, given the repo owner, name, and archive type --- --- > archiveFor "thoughtbot" "paperclip" ArchiveFormatTarball Nothing -archiveFor :: Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) -archiveFor = archiveFor' Nothing - --- | The archive of a repo, given the repo owner, name, and archive type --- With Authentication --- --- > archiveFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" ArchiveFormatTarball Nothing -archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) -archiveFor' auth user repo path ref = - executeRequestMaybe auth $ archiveForR user repo path ref - -- | Get archive link. -- See archiveForR @@ -110,16 +58,6 @@ archiveForR user repo format ref = Query path [] where path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref --- | Create a file. -createFile - :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> CreateFile - -> IO (Either Error ContentResult) -createFile auth user repo body = - executeRequest auth $ createFileR user repo body - -- | Create a file. -- See createFileR @@ -130,16 +68,6 @@ createFileR createFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) --- | Update a file. -updateFile - :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> UpdateFile - -> IO (Either Error ContentResult) -updateFile auth user repo body = - executeRequest auth $ updateFileR user repo body - -- | Update a file. -- See updateFileR @@ -150,16 +78,6 @@ updateFileR updateFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) --- | Delete a file. -deleteFile - :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> DeleteFile - -> IO (Either Error ()) -deleteFile auth user repo body = - executeRequest auth $ deleteFileR user repo body - -- | Delete a file. -- See deleteFileR diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index f1080680..cddbf823 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -7,62 +7,38 @@ -- module GitHub.Endpoints.Repos.DeployKeys ( -- * Querying deploy keys - deployKeysFor', deployKeysForR, - deployKeyFor', deployKeyForR, -- ** Create - createRepoDeployKey', createRepoDeployKeyR, -- ** Delete - deleteRepoDeployKey', deleteRepoDeployKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Querying deploy keys. -deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) -deployKeysFor' auth user repo = - executeRequest auth $ deployKeysForR user repo FetchAll - -- | Querying deploy keys. -- See deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] --- | Querying a deploy key -deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) -deployKeyFor' auth user repo keyId = - executeRequest auth $ deployKeyForR user repo keyId - -- | Querying a deploy key. -- See deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] --- | Create a deploy key -createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) -createRepoDeployKey' auth user repo key = - executeRequest auth $ createRepoDeployKeyR user repo key - -- | Create a deploy key. -- See . createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) -deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) -deleteRepoDeployKey' auth user repo keyId = - executeRequest auth $ deleteRepoDeployKeyR user repo keyId - -- | Delete a deploy key. -- See deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 5ca6ac14..f556e1f8 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -6,31 +6,14 @@ -- Hot forking action, as described at -- . module GitHub.Endpoints.Repos.Forks ( - forksFor, - forksFor', forksForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the repos that are forked off the given repo. --- --- > forksFor "thoughtbot" "paperclip" -forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) -forksFor = forksFor' Nothing - --- | All the repos that are forked off the given repo. --- | With authentication --- --- > forksFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) -forksFor' auth user repo = - executeRequestMaybe auth $ forksForR user repo FetchAll - -- | List forks. -- See forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs index 9c0e4ed4..6c96bee1 100644 --- a/src/GitHub/Endpoints/Repos/Releases.hs +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -1,96 +1,35 @@ -- The Release API, as described at -- . module GitHub.Endpoints.Repos.Releases ( - releases, - releases', releasesR, - release, - release', releaseR, - latestRelease, - latestRelease', latestReleaseR, - releaseByTagName, - releaseByTagName', releaseByTagNameR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All releases for the given repo. --- --- > releases "calleerlandsson" "pick" -releases :: Name Owner -> Name Repo -> IO (Either Error (Vector Release)) -releases = releases' Nothing - --- | All releases for the given repo with authentication. --- --- > releases' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) -releases' auth user repo = - executeRequestMaybe auth $ releasesR user repo FetchAll - -- | List releases for a repository. -- See releasesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Release) releasesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "releases"] [] --- | Query a single release. --- --- > release "calleerlandsson" "pick" -release :: Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) -release = release' Nothing - --- | Query a single release with authentication. --- --- > release' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) -release' auth user repo reqReleaseId = - executeRequestMaybe auth $ releaseR user repo reqReleaseId - -- | Get a single release. -- See releaseR :: Name Owner -> Name Repo -> Id Release -> Request k Release releaseR user repo reqReleaseId = query ["repos", toPathPart user, toPathPart repo, "releases", toPathPart reqReleaseId ] [] --- | Query latest release. --- --- > latestRelease "calleerlandsson" "pick" -latestRelease :: Name Owner -> Name Repo -> IO (Either Error Release) -latestRelease = latestRelease' Nothing - --- | Query latest release with authentication. --- --- > latestRelease' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) -latestRelease' auth user repo = - executeRequestMaybe auth $ latestReleaseR user repo - -- | Get the latest release. -- See latestReleaseR :: Name Owner -> Name Repo -> Request k Release latestReleaseR user repo = query ["repos", toPathPart user, toPathPart repo, "releases", "latest" ] [] --- | Query release by tag name. --- --- > releaseByTagName "calleerlandsson" "pick" -releaseByTagName :: Name Owner -> Name Repo -> Text -> IO (Either Error Release) -releaseByTagName = releaseByTagName' Nothing - --- | Query release by tag name with authentication. --- --- > releaseByTagName' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) -releaseByTagName' auth user repo reqTagName = - executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName - -- | Get a release by tag name -- See releaseByTagNameR :: Name Owner -> Name Repo -> Text -> Request k Release diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index d25186d6..1c1f167d 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -6,29 +6,16 @@ -- The repo statuses API as described on -- . module GitHub.Endpoints.Repos.Statuses ( - createStatus, createStatusR, - statusesFor, statusesForR, - statusFor, statusForR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Create a new status --- --- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" --- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" --- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) -createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) -createStatus auth owner repo sha ns = - executeRequest auth $ createStatusR owner repo sha ns - -- | Create a new status -- See createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status @@ -37,28 +24,12 @@ createStatusR owner repo sha = where parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] --- | All statuses for a commit --- --- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" --- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) -statusesFor auth user repo sha = - executeRequest auth $ statusesForR user repo sha FetchAll - -- | All statuses for a commit -- See statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) statusesForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] --- | The combined status for a specific commit --- --- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" --- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) -statusFor auth user repo sha = - executeRequest auth $ statusForR user repo sha - -- | The combined status for a specific commit -- See statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 87e37fba..8b828f30 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -8,99 +8,61 @@ -- module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories - webhooksFor', webhooksForR, - webhookFor', webhookForR, -- ** Create - createRepoWebhook', createRepoWebhookR, -- ** Edit - editRepoWebhook', editRepoWebhookR, -- ** Test - testPushRepoWebhook', testPushRepoWebhookR, - pingRepoWebhook', pingRepoWebhookR, -- ** Delete - deleteRepoWebhook', deleteRepoWebhookR, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) -webhooksFor' auth user repo = - executeRequest auth $ webhooksForR user repo FetchAll - -- | List hooks. -- See webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] - -webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) -webhookFor' auth user repo hookId = - executeRequest auth $ webhookForR user repo hookId - --- | Query single hook. -- See webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] -createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) -createRepoWebhook' auth user repo hook = - executeRequest auth $ createRepoWebhookR user repo hook - -- | Create a hook. -- See createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) -editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) -editRepoWebhook' auth user repo hookId hookEdit = - executeRequest auth $ editRepoWebhookR user repo hookId hookEdit - -- | Edit a hook. -- See editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) -testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) -testPushRepoWebhook' auth user repo hookId = - executeRequest auth $ testPushRepoWebhookR user repo hookId - -- | Test a push hook. -- See testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool testPushRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) -pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) -pingRepoWebhook' auth user repo hookId = - executeRequest auth $ pingRepoWebhookR user repo hookId - -- | Ping a hook. -- See pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool pingRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) -deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) -deleteRepoWebhook' auth user repo hookId = - executeRequest auth $ deleteRepoWebhookR user repo hookId - -- | Delete a hook. -- See deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 58a0e4e5..26c134bd 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -6,79 +6,30 @@ -- The Github Search API, as described at -- . module GitHub.Endpoints.Search( - searchRepos', - searchRepos, searchReposR, - searchCode', - searchCode, searchCodeR, - searchIssues', - searchIssues, searchIssuesR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import qualified Data.Text.Encoding as TE --- | Perform a repository search. --- With authentication. --- --- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) -searchRepos' auth = executeRequestMaybe auth . searchReposR - --- | Perform a repository search. --- Without authentication. --- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: Text -> IO (Either Error (SearchResult Repo)) -searchRepos = searchRepos' Nothing - -- | Search repositories. -- See searchReposR :: Text -> Request k (SearchResult Repo) searchReposR searchString = query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] --- | Perform a code search. --- With authentication. --- --- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) -searchCode' auth = executeRequestMaybe auth . searchCodeR - --- | Perform a code search. --- Without authentication. --- --- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: Text -> IO (Either Error (SearchResult Code)) -searchCode = searchCode' Nothing - -- | Search code. -- See searchCodeR :: Text -> Request k (SearchResult Code) searchCodeR searchString = query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] --- | Perform an issue search. --- With authentication. --- --- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) -searchIssues' auth = executeRequestMaybe auth . searchIssuesR - --- | Perform an issue search. --- Without authentication. --- --- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: Text -> IO (Either Error (SearchResult Issue)) -searchIssues = searchIssues' Nothing - -- | Search issues. -- See searchIssuesR :: Text -> Request k (SearchResult Issue) diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index b3f7621c..ef68bba6 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -6,35 +6,24 @@ -- The Github Users API, as described at -- . module GitHub.Endpoints.Users ( - userInfoFor, - userInfoFor', userInfoForR, ownerInfoForR, - userInfoCurrent', userInfoCurrentR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The information for a single user, by login name. --- With authentification --- --- > userInfoFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" -userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) -userInfoFor' auth = executeRequestMaybe auth . userInfoForR - --- | The information for a single user, by login name. --- --- > userInfoFor "mike-burns" -userInfoFor :: Name User -> IO (Either Error User) -userInfoFor = executeRequest' . userInfoForR - -- | Query a single user. -- See +-- +-- >>> github' userInfoForR "mike-burns" +-- +-- or +-- +-- >>> github userInfoForR (OAuth "github-token") "mike-burns" +-- userInfoForR :: Name User -> Request k User userInfoForR user = query ["users", toPathPart user] [] @@ -43,13 +32,6 @@ userInfoForR user = query ["users", toPathPart user] [] ownerInfoForR :: Name Owner -> Request k Owner ownerInfoForR owner = query ["users", toPathPart owner] [] --- | Retrieve information about the user associated with the supplied authentication. --- --- > userInfoCurrent' (OAuth "...") -userInfoCurrent' :: Auth -> IO (Either Error User) -userInfoCurrent' auth = - executeRequest auth $ userInfoCurrentR - -- | Query the authenticated user. -- See userInfoCurrentR :: Request 'RA User diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs index c432aae6..9ba76389 100644 --- a/src/GitHub/Endpoints/Users/Emails.hs +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -6,38 +6,21 @@ -- The user emails API as described on -- . module GitHub.Endpoints.Users.Emails ( - currentUserEmails', currentUserEmailsR, - currentUserPublicEmails', currentUserPublicEmailsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | List email addresses for the authenticated user. --- --- > currentUserEmails' (OAuth "token") -currentUserEmails' :: Auth -> IO (Either Error (Vector Email)) -currentUserEmails' auth = - executeRequest auth $ currentUserEmailsR FetchAll - -- | List email addresses. -- See currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) currentUserEmailsR = pagedQuery ["user", "emails"] [] --- | List public email addresses for the authenticated user. --- --- > currentUserPublicEmails' (OAuth "token") -currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email)) -currentUserPublicEmails' auth = - executeRequest auth $ currentUserPublicEmailsR FetchAll - -- | List public email addresses. -- See currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index 8ab72ce4..db58900f 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -6,8 +6,6 @@ -- The user followers API as described on -- . module GitHub.Endpoints.Users.Followers ( - usersFollowing, - usersFollowedBy, usersFollowingR, usersFollowedByR, module GitHub.Data, @@ -15,29 +13,14 @@ module GitHub.Endpoints.Users.Followers ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the users following the given user. --- --- > usersFollowing "mike-burns" -usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) -usersFollowing user = - executeRequest' $ usersFollowingR user FetchAll - -- | List followers of a user. -- See usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowingR user = pagedQuery ["users", toPathPart user, "followers"] [] --- | All the users that the given user follows. --- --- > usersFollowedBy "mike-burns" -usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) -usersFollowedBy user = - executeRequest' $ usersFollowedByR user FetchAll - -- | List users followed by another user. -- See usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs index 0eb9a4ee..663e2641 100644 --- a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -7,75 +7,45 @@ -- module GitHub.Endpoints.Users.PublicSSHKeys ( -- * Querying public SSH keys - publicSSHKeys', publicSSHKeysR, - publicSSHKeysFor', publicSSHKeysForR, - publicSSHKey', publicSSHKeyR, -- ** Create - createUserPublicSSHKey', createUserPublicSSHKeyR, -- ** Delete - deleteUserPublicSSHKey', deleteUserPublicSSHKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Querying public SSH keys. -publicSSHKeysFor' :: Name Owner -> IO (Either Error (Vector PublicSSHKeyBasic)) -publicSSHKeysFor' user = - executeRequest' $ publicSSHKeysForR user FetchAll - -- | Querying public SSH keys. -- See publicSSHKeysForR :: Name Owner -> FetchCount -> Request 'RO (Vector PublicSSHKeyBasic) publicSSHKeysForR user = pagedQuery ["users", toPathPart user, "keys"] [] --- | Querying the authenticated users' public SSH keys -publicSSHKeys' :: Auth -> IO (Either Error (Vector PublicSSHKey)) -publicSSHKeys' auth = - executeRequest auth publicSSHKeysR - -- | Querying the authenticated users' public SSH keys -- See publicSSHKeysR :: Request 'RA (Vector PublicSSHKey) publicSSHKeysR = query ["user", "keys"] [] --- | Querying a public SSH key -publicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error PublicSSHKey) -publicSSHKey' auth keyId = - executeRequest auth $ publicSSHKeyR keyId - -- | Querying a public SSH key. -- See publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey publicSSHKeyR keyId = query ["user", "keys", toPathPart keyId] [] --- | Create a public SSH key -createUserPublicSSHKey' :: Auth -> NewPublicSSHKey -> IO (Either Error PublicSSHKey) -createUserPublicSSHKey' auth key = - executeRequest auth $ createUserPublicSSHKeyR key - -- | Create a public SSH key. -- See . createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey createUserPublicSSHKeyR key = command Post ["user", "keys"] (encode key) -deleteUserPublicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error ()) -deleteUserPublicSSHKey' auth keyId = - executeRequest auth $ deleteUserPublicSSHKeyR keyId - -- | Delete a public SSH key. -- See deleteUserPublicSSHKeyR :: Id PublicSSHKey -> GenRequest 'MtUnit 'RW () From 7f103113066c38b8c87f833ea8221e01227ac61f Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 02:46:31 +0200 Subject: [PATCH 193/309] Remove some committed in haddock artifacts --- src/highlight.js | 27 ------------------------ src/style.css | 55 ------------------------------------------------ 2 files changed, 82 deletions(-) delete mode 100644 src/highlight.js delete mode 100644 src/style.css 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; -} From dab2a747a1d20746a7701c2c968bc2d35bcfb1cd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 02:51:40 +0200 Subject: [PATCH 194/309] Bump version to 0.24 --- CHANGELOG.md | 19 ++++++++++++++++++- github.cabal | 2 +- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fa23d79e..cdc67227 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,20 @@ +## Changes for 0.24 + +**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/phadej/github/pull/415) + +- Remove double `withOpenSSL` + [#414](https://github.com/phadej/github/pull/414) +- Pull requests reviews API uses issue number + [#409](https://github.com/phadej/github/pull/409) +- Update `Repo`, `NewRepo` and `EditRepo` data types + [#407](https://github.com/phadej/github/pull/407) + ## Changes for 0.23 - Escape URI paths @@ -93,7 +110,7 @@ ## Changes for 0.18 -- Endpoints for deleting issue comments. +- Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) - Endpoints for (un)starring gists. [#296](https://github.com/phadej/github/pull/296) diff --git a/github.cabal b/github.cabal index ff5c3c2a..b3a18432 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.23 +version: 0.24 synopsis: Access to the GitHub API, v3. category: Network description: From 01de4b16d2f1ef2aea3d437f1697ea5f318701bb Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 14:35:13 +0200 Subject: [PATCH 195/309] Remove nix stuff --- default.nix | 3 --- overlay.nix | 31 ------------------------------- 2 files changed, 34 deletions(-) delete mode 100644 default.nix delete mode 100644 overlay.nix diff --git a/default.nix b/default.nix deleted file mode 100644 index e8e50a1b..00000000 --- a/default.nix +++ /dev/null @@ -1,3 +0,0 @@ -let - pkgs = import { overlays = [ (import ./overlay.nix) ]; }; -in pkgs.haskellPackages.callCabal2nix "github" ./. { } diff --git a/overlay.nix b/overlay.nix deleted file mode 100644 index 173f195e..00000000 --- a/overlay.nix +++ /dev/null @@ -1,31 +0,0 @@ -_: pkgs: { - haskellPackages = pkgs.haskellPackages.override (old: { - overrides = pkgs.lib.composeExtensions (old.overrides or (_: _: {})) (self: super: { - unordered-containers = pkgs.haskell.lib.overrideCabal super.unordered-containers (_: { - version = "0.2.10.0"; - sha256 = "0wy5hfrs880hh8hvp648bl07ws777n3kkmczzdszr7papnyigwb5"; - }); - binary-instances = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.binary-instances (old: { - libraryHaskellDepends = old.libraryHaskellDepends ++ [ - self.binary-orphans_1_0_1 - ]; - broken = false; - })); - binary-orphans_1_0_1 = pkgs.haskell.lib.dontCheck super.binary-orphans_1_0_1; - github = pkgs.haskell.lib.overrideCabal super.github (old: { - version = "0.22"; - sha256 = "15py79qcpj0k331i42njgwkirwyiacbc5razmxnm4672dvvip2qk"; - libraryHaskellDepends = old.libraryHaskellDepends ++ [ - self.binary-instances self.exceptions self.transformers-compat - ]; - }); - time-compat = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.time-compat (old: { - version = "1.9.2.2"; - sha256 = "05va0rqs759vbridbcl6hksp967j9anjvys8vx72fnfkhlrn2s52"; - libraryHaskellDepends = old.libraryHaskellDepends ++ [ - self.base-orphans - ]; - })); - }); - }); -} From e99858d26ed21472b2405a56e42c73693b319145 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 3 Dec 2019 11:48:37 +0200 Subject: [PATCH 196/309] Remove stackage badges from README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 877c51dc..45492903 100644 --- a/README.md +++ b/README.md @@ -3,8 +3,6 @@ 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) The Github API v3 for Haskell. @@ -34,6 +32,8 @@ Example Usage See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory. +Note: some samples might be outdated. + Documentation ============= From 75afbf8d7bfa4d82724064a9a10ef49da9ff29d1 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Sat, 14 Dec 2019 23:42:27 +1100 Subject: [PATCH 197/309] Add openssl flag to samples --- cabal.project | 1 + samples/Operational/Operational.hs | 14 +++++++++++++- samples/github-samples.cabal | 18 +++++++++++++++--- 3 files changed, 29 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index 26dc579d..555119f5 100644 --- a/cabal.project +++ b/cabal.project @@ -8,3 +8,4 @@ constraints: hashable ^>=1.3 constraints: semigroups ^>=0.19 constraints: github +openssl +constraints: github-samples +openssl diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index ea8208e7..1117e72e 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,11 +10,17 @@ import Prelude () import Control.Monad.Operational import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Network.HTTP.Client (Manager, newManager, ManagerSettings) + +#ifdef MIN_VERSION_http_client_tls +import Network.HTTP.Client.TLS (tlsManagerSettings) +#else import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified GitHub as GH import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL +#endif + +import qualified GitHub as GH data R a where R :: FromJSON a => GH.Request 'GH.RA a -> R a @@ -42,6 +49,10 @@ main = withOpenSSL $ do githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner +#ifdef MIN_VERSION_http_client_tls +withOpenSSL :: IO a -> IO a +withOpenSSL = id +#else tlsManagerSettings :: ManagerSettings tlsManagerSettings = opensslManagerSettings $ do ctx <- SSL.context @@ -52,3 +63,4 @@ tlsManagerSettings = opensslManagerSettings $ do SSL.contextLoadSystemCerts ctx SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing return ctx +#endif diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index f0d4a4e7..2b4d2f69 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -17,6 +17,11 @@ tested-with: || ==8.6.5 || ==8.8.1 +flag openssl + description: "Use http-client-openssl" + manual: True + default: False + library hs-source-dirs: src ghc-options: -Wall @@ -38,15 +43,22 @@ executable github-operational , base-compat-batteries , github , github-samples - , HsOpenSSL - , HsOpenSSL-x509-system , http-client - , http-client-openssl , operational , text , transformers , transformers-compat + if flag(openssl) + build-depends: + HsOpenSSL + , HsOpenSSL-x509-system + , http-client-openssl + + else + build-depends: + http-client-tls + default-language: Haskell2010 common deps From 6b42b3031961920bdb719227893566dbd81f9ce5 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Sun, 15 Dec 2019 22:13:36 +1100 Subject: [PATCH 198/309] Manage orgs in GitHub Enterprise --- github.cabal | 2 + src/GitHub.hs | 9 +++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Enterprise/Organizations.hs | 64 +++++++++++++++++++ .../Endpoints/Enterprise/Organizations.hs | 27 ++++++++ 5 files changed, 104 insertions(+) create mode 100644 src/GitHub/Data/Enterprise/Organizations.hs create mode 100644 src/GitHub/Endpoints/Enterprise/Organizations.hs diff --git a/github.cabal b/github.cabal index b3a18432..669bbb77 100644 --- a/github.cabal +++ b/github.cabal @@ -90,6 +90,7 @@ library GitHub.Data.DeployKeys GitHub.Data.Deployments GitHub.Data.Email + GitHub.Data.Enterprise.Organizations GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData @@ -116,6 +117,7 @@ library 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 diff --git a/src/GitHub.hs b/src/GitHub.hs index 2faf1618..d5845972 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -56,6 +56,14 @@ module GitHub ( watchersForR, reposWatchedByR, + -- * Enterprise + -- | See + + -- ** Organizations + -- | See + createOrganizationR, + renameOrganizationR, + -- * Gists -- | See -- @@ -401,6 +409,7 @@ import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching +import GitHub.Endpoints.Enterprise.Organizations import GitHub.Endpoints.Gists import GitHub.Endpoints.Gists.Comments import GitHub.Endpoints.GitData.Blobs diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 6acc0bf2..bdedb894 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -41,6 +41,7 @@ module GitHub.Data ( module GitHub.Data.DeployKeys, module GitHub.Data.Deployments, module GitHub.Data.Email, + module GitHub.Data.Enterprise.Organizations, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, @@ -73,6 +74,7 @@ import GitHub.Data.Definitions import GitHub.Data.DeployKeys import GitHub.Data.Deployments import GitHub.Data.Email +import GitHub.Data.Enterprise.Organizations import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs new file mode 100644 index 00000000..967cd718 --- /dev/null +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -0,0 +1,64 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +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, Typeable, Eq, Ord, Generic) + +instance NFData CreateOrganization where rnf = genericRnf +instance Binary CreateOrganization + +data RenameOrganization = RenameOrganization + { renameOrganizationLogin :: !(Name Organization) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RenameOrganization where rnf = genericRnf +instance Binary RenameOrganization + +data RenameOrganizationResponse = RenameOrganizationResponse + { renameOrganizationResponseMessage :: !Text + , renameOrganizationResponseUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RenameOrganizationResponse where rnf = genericRnf +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/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs new file mode 100644 index 00000000..d94c7c72 --- /dev/null +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -0,0 +1,27 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The GitHub Enterprise orgs API as described on . +module GitHub.Endpoints.Enterprise.Organizations ( + createOrganizationR, + renameOrganizationR, + module GitHub.Data, + ) where + +import GitHub.Data +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 From b277deb25f76b88cd28d2c97b715041e05346d7f Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Mon, 16 Dec 2019 19:24:18 +1100 Subject: [PATCH 199/309] Add samples for GitHub Enterprise org management --- samples/Enterprise/CreateOrganization.hs | 29 ++++++++++++++++++++++++ samples/Enterprise/RenameOrganization.hs | 28 +++++++++++++++++++++++ samples/github-samples.cabal | 10 ++++++++ 3 files changed, 67 insertions(+) create mode 100644 samples/Enterprise/CreateOrganization.hs create mode 100644 samples/Enterprise/RenameOrganization.hs diff --git a/samples/Enterprise/CreateOrganization.hs b/samples/Enterprise/CreateOrganization.hs new file mode 100644 index 00000000..897e7cd5 --- /dev/null +++ b/samples/Enterprise/CreateOrganization.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified 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..bee86142 --- /dev/null +++ b/samples/Enterprise/RenameOrganization.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified 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/github-samples.cabal b/samples/github-samples.cabal index 2b4d2f69..b6a75728 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -98,6 +98,16 @@ executable github-create-deploy-key -- main-is: DeleteTeamMembershipFor.hs -- hs-source-dirs: Teams/Memberships +executable github-enterprise-create-organization + import: deps + main-is: CreateOrganization.hs + hs-source-dirs: Enterprise + +executable github-enterprise-rename-organization + import: deps + main-is: RenameOrganization.hs + hs-source-dirs: Enterprise + executable github-edit-team import: deps main-is: EditTeam.hs From 3fb5f0ce6c0359f37909d3315cee6c6ef9b38db8 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Mon, 16 Dec 2019 20:42:26 +1100 Subject: [PATCH 200/309] Add GitHub.Enterprise module --- github.cabal | 2 ++ samples/Enterprise/CreateOrganization.hs | 1 + samples/Enterprise/RenameOrganization.hs | 1 + src/GitHub.hs | 2 +- src/GitHub/Data.hs | 2 -- src/GitHub/Data/Enterprise.hs | 12 ++++++++++ .../Endpoints/Enterprise/Organizations.hs | 1 + src/GitHub/Enterprise.hs | 23 +++++++++++++++++++ 8 files changed, 41 insertions(+), 3 deletions(-) create mode 100644 src/GitHub/Data/Enterprise.hs create mode 100644 src/GitHub/Enterprise.hs diff --git a/github.cabal b/github.cabal index 669bbb77..700d80cf 100644 --- a/github.cabal +++ b/github.cabal @@ -90,6 +90,7 @@ library GitHub.Data.DeployKeys GitHub.Data.Deployments GitHub.Data.Email + GitHub.Data.Enterprise GitHub.Data.Enterprise.Organizations GitHub.Data.Events GitHub.Data.Gists @@ -153,6 +154,7 @@ library GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers GitHub.Endpoints.Users.PublicSSHKeys + GitHub.Enterprise GitHub.Internal.Prelude GitHub.Request diff --git a/samples/Enterprise/CreateOrganization.hs b/samples/Enterprise/CreateOrganization.hs index 897e7cd5..32fc97cc 100644 --- a/samples/Enterprise/CreateOrganization.hs +++ b/samples/Enterprise/CreateOrganization.hs @@ -5,6 +5,7 @@ module Main (main) where import Common import qualified GitHub +import qualified GitHub.Enterprise as GitHub main :: IO () main = do diff --git a/samples/Enterprise/RenameOrganization.hs b/samples/Enterprise/RenameOrganization.hs index bee86142..c16fdf56 100644 --- a/samples/Enterprise/RenameOrganization.hs +++ b/samples/Enterprise/RenameOrganization.hs @@ -5,6 +5,7 @@ module Main (main) where import Common import qualified GitHub +import qualified GitHub.Enterprise as GitHub main :: IO () main = do diff --git a/src/GitHub.hs b/src/GitHub.hs index d5845972..850258d1 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -3,7 +3,7 @@ -- 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', in short diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index bdedb894..6acc0bf2 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -41,7 +41,6 @@ module GitHub.Data ( module GitHub.Data.DeployKeys, module GitHub.Data.Deployments, module GitHub.Data.Email, - module GitHub.Data.Enterprise.Organizations, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, @@ -74,7 +73,6 @@ import GitHub.Data.Definitions import GitHub.Data.DeployKeys import GitHub.Data.Deployments import GitHub.Data.Email -import GitHub.Data.Enterprise.Organizations import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData diff --git a/src/GitHub/Data/Enterprise.hs b/src/GitHub/Data/Enterprise.hs new file mode 100644 index 00000000..125a8d69 --- /dev/null +++ b/src/GitHub/Data/Enterprise.hs @@ -0,0 +1,12 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- 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/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs index d94c7c72..589c3d35 100644 --- a/src/GitHub/Endpoints/Enterprise/Organizations.hs +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -11,6 +11,7 @@ module GitHub.Endpoints.Enterprise.Organizations ( ) where import GitHub.Data +import GitHub.Data.Enterprise import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Enterprise.hs b/src/GitHub/Enterprise.hs new file mode 100644 index 00000000..bb64b7d7 --- /dev/null +++ b/src/GitHub/Enterprise.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- 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 From b7ee2b803157948479ceccd85233aa1e9474adc9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 19 Dec 2019 15:55:38 +0200 Subject: [PATCH 201/309] Export withOpenSSL and tlsManagerSettings --- samples/Operational/Operational.hs | 31 +++--------------------------- samples/github-samples.cabal | 18 +---------------- src/GitHub/Request.hs | 5 +++++ 3 files changed, 9 insertions(+), 45 deletions(-) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 1117e72e..15833ece 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -9,16 +9,7 @@ import Prelude () import Control.Monad.Operational import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Network.HTTP.Client (Manager, newManager, ManagerSettings) - -#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 Network.HTTP.Client (Manager, newManager) import qualified GitHub as GH @@ -38,8 +29,8 @@ githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton . R main :: IO () -main = withOpenSSL $ do - manager <- newManager tlsManagerSettings +main = GH.withOpenSSL $ do + manager <- newManager GH.tlsManagerSettings auth' <- getAuth case auth' of Nothing -> return () @@ -48,19 +39,3 @@ main = withOpenSSL $ do repo <- githubRequest $ GH.repositoryR "phadej" "github" githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner - -#ifdef MIN_VERSION_http_client_tls -withOpenSSL :: IO a -> IO a -withOpenSSL = id -#else -tlsManagerSettings :: 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 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 2b4d2f69..a26ffcfe 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -17,11 +17,6 @@ tested-with: || ==8.6.5 || ==8.8.1 -flag openssl - description: "Use http-client-openssl" - manual: True - default: False - library hs-source-dirs: src ghc-options: -Wall @@ -35,6 +30,7 @@ library default-language: Haskell2010 executable github-operational + default-language: Haskell2010 main-is: Operational.hs hs-source-dirs: Operational ghc-options: -Wall -threaded @@ -49,18 +45,6 @@ executable github-operational , transformers , transformers-compat - if flag(openssl) - build-depends: - HsOpenSSL - , HsOpenSSL-x509-system - , http-client-openssl - - else - build-depends: - http-client-tls - - default-language: Haskell2010 - common deps default-language: Haskell2010 ghc-options: -Wall diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 83eba89b..fc0fd7dd 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -62,6 +62,11 @@ module GitHub.Request ( -- ** Preview PreviewAccept (..), PreviewParseResponse (..), + -- * SSL + -- | This always exist, independently of @openssl@ configuration flag. + -- They change accordingly, to make use of the library simpler. + withOpenSSL, + tlsManagerSettings, ) where import GitHub.Internal.Prelude From 2503b54595acee2683b81bf37d1f927f6e32b3c4 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Fri, 20 Dec 2019 22:26:03 +1100 Subject: [PATCH 202/309] Label description (#418) * Add description field to IssueLabel * Add types for Update and New label * Use NewIssueLabel and UpdateIssueLabel for generating requests --- src/GitHub/Data/Definitions.hs | 55 +++++++++++++++++++++++++++ src/GitHub/Endpoints/Issues/Labels.hs | 19 +++------ 2 files changed, 61 insertions(+), 13 deletions(-) diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index f4503e66..8da8b761 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -268,6 +268,7 @@ data IssueLabel = IssueLabel { labelColor :: !Text , labelUrl :: !URL , labelName :: !(Name IssueLabel) + , labelDesc :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -279,3 +280,57 @@ instance FromJSON IssueLabel where <$> 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, Typeable, Eq, Ord, Generic) + +instance NFData NewIssueLabel where rnf = genericRnf +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, Typeable, Eq, Ord, Generic) + +instance NFData UpdateIssueLabel where rnf = genericRnf +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/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index cb80992e..3d129e8c 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -38,26 +38,19 @@ labelR user repo lbl = -- | Create a label. -- See -createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel -createLabelR user repo lbl color = - command Post paths $ encode body - where - paths = ["repos", toPathPart user, toPathPart repo, "labels"] - body = object ["name" .= untagName lbl, "color" .= color] +createLabelR :: Name Owner -> Name Repo -> NewIssueLabel -> Request 'RW IssueLabel +createLabelR user repo = + command Post ["repos", toPathPart user, toPathPart repo, "labels"] . encode -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name - -> Name IssueLabel -- ^ new label name - -> String -- ^ new color + -> UpdateIssueLabel -- ^ new label -> Request 'RW IssueLabel -updateLabelR user repo oldLbl newLbl color = - command Patch paths (encode body) - where - paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] - body = object ["name" .= untagName newLbl, "color" .= color] +updateLabelR user repo oldLbl = + command Patch ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] . encode -- | Delete a label. -- See From bbe378bbe2fad28ff4069537bc2b46fa4b8e89c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 20 Dec 2019 15:17:59 +0200 Subject: [PATCH 203/309] Add executeRequestWithMgrAndRes --- CHANGELOG.md | 6 +++ github.cabal | 2 +- samples/Operational/Operational.hs | 34 +++++++++----- src/GitHub/Auth.hs | 6 +++ src/GitHub/Data/Deployments.hs | 1 - src/GitHub/Data/RateLimit.hs | 31 +++++++++++-- src/GitHub/Internal/Prelude.hs | 2 +- src/GitHub/Request.hs | 74 +++++++++++++++--------------- 8 files changed, 102 insertions(+), 54 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cdc67227..8d776cb8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,12 @@ This reduces symbol bloat in the library. [#409](https://github.com/phadej/github/pull/409) - Update `Repo`, `NewRepo` and `EditRepo` data types [#407](https://github.com/phadej/github/pull/407) +- Add `executeRequestWithMgrAndRes` + [#421](https://github.com/phadej/github/pull/421) +- Add `limitsFromHttpResponse` + [#421](https://github.com/phadej/github/pull/421) +- Add label descriptions + [#418](https://github.com/phadej/github/pull/418) ## Changes for 0.23 diff --git a/github.cabal b/github.cabal index b3a18432..0e9a7335 100644 --- a/github.cabal +++ b/github.cabal @@ -165,7 +165,7 @@ library , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 , text >=1.2.0.6 && <1.3 - , time >=1.4 && <1.10 + , time-compat >=1.9.2.2 && <1.10 , transformers >=0.3.0.0 && <0.6 -- other packages diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 15833ece..4e669ff4 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -7,23 +7,26 @@ module Main (main) where import Common import Prelude () -import Control.Monad.Operational -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Network.HTTP.Client (Manager, newManager) +import Control.Exception (throw) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Operational (Program, ProgramViewT (..), singleton, view) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Network.HTTP.Client (Manager, newManager, responseBody) -import qualified GitHub as GH +import qualified GitHub as GH data R a where R :: FromJSON a => GH.Request 'GH.RA a -> R a type GithubMonad a = Program R a -runMonad :: 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 R req :>>= k -> do - b <- ExceptT $ GH.executeRequestWithMgr mgr auth req - runMonad mgr auth (k b) + res <- ExceptT $ GH.executeRequestWithMgrAndRes mgr auth req + liftIO $ print $ GH.limitsFromHttpResponse res + runMonad mgr auth (k (responseBody res)) githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton . R @@ -33,9 +36,18 @@ 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 "phadej" "github" + owner <- githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + rl <- githubRequest GH.rateLimitR + return (owner, GH.rateLimitCore rl) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 7918c0af..432b2486 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -30,12 +30,18 @@ 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 diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index 9e65485d..face7a52 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -21,7 +21,6 @@ import Control.Arrow (second) import Data.ByteString (ByteString) import Data.Maybe (catMaybes) import Data.Text (Text) -import Data.Time.Clock (UTCTime) import Data.Vector (Vector) import GitHub.Data.Definitions (SimpleUser) diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 3fbd6211..2ba008f0 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -8,12 +8,17 @@ module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () +import Data.Time.Clock.System.Compat (SystemTime (..)) + +import qualified Data.ByteString.Char8 as BS8 +import qualified Network.HTTP.Client as HTTP + data Limits = Limits { limitsMax :: !Int , limitsRemaining :: !Int - , limitsReset :: !Int -- TODO: change to proper type + , limitsReset :: !SystemTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) instance NFData Limits where rnf = genericRnf instance Binary Limits @@ -22,14 +27,14 @@ instance FromJSON Limits where parseJSON = withObject "Limits" $ \obj -> Limits <$> obj .: "limit" <*> obj .: "remaining" - <*> obj .: "reset" + <*> fmap (\t -> MkSystemTime t 0) (obj .: "reset") data RateLimit = RateLimit { rateLimitCore :: Limits , rateLimitSearch :: Limits , rateLimitGraphQL :: Limits } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) instance NFData RateLimit where rnf = genericRnf instance Binary RateLimit @@ -41,3 +46,21 @@ instance FromJSON RateLimit where <$> 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/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 07a748b3..8c4785c3 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -53,7 +53,7 @@ import Data.Maybe (catMaybes) import Data.Semigroup (Semigroup (..)) import Data.String (IsString (..)) import Data.Text (Text, pack, unpack) -import Data.Time (UTCTime) +import Data.Time.Compat (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) import Data.Vector.Instances () diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index fc0fd7dd..b72d25be 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -46,6 +46,7 @@ module GitHub.Request ( -- * Request execution in IO executeRequest, executeRequestWithMgr, + executeRequestWithMgrAndRes, executeRequest', executeRequestWithMgr', executeRequestMaybe, @@ -66,7 +67,7 @@ module GitHub.Request ( -- | This always exist, independently of @openssl@ configuration flag. -- They change accordingly, to make use of the library simpler. withOpenSSL, - tlsManagerSettings, + tlsManagerSettings, ) where import GitHub.Internal.Prelude @@ -112,7 +113,7 @@ import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL #endif -import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) +import GitHub.Auth (AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request @@ -206,6 +207,7 @@ lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True lessFetchCount i (FetchAtLeast j) = i < fromIntegral j + -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -213,26 +215,38 @@ executeRequestWithMgr -> am -> GenRequest mt rw a -> IO (Either Error a) -executeRequestWithMgr mgr auth req = runExceptT $ do +executeRequestWithMgr mgr auth req = + fmap (fmap responseBody) (executeRequestWithMgrAndRes mgr auth req) + +-- | Execute request and return the last received 'HTTP.Response'. +-- +-- @since 0.24 +executeRequestWithMgrAndRes + :: (AuthMethod am, ParseResponse mt a) + => Manager + -> am + -> GenRequest mt rw a + -> IO (Either Error (HTTP.Response a)) +executeRequestWithMgrAndRes mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req performHttpReq httpReq req where - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO b + 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 - unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) where predicate v = lessFetchCount (V.length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq - unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) -- | Like 'executeRequest' but without authentication. executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) @@ -246,21 +260,7 @@ executeRequestWithMgr' => Manager -> GenRequest mt 'RO a -> IO (Either Error a) -executeRequestWithMgr' mgr req = runExceptT $ do - httpReq <- makeHttpRequest (Nothing :: Maybe Auth) req - performHttpReq httpReq req - where - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) - httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - - performHttpReq :: forall mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt 'RO b -> ExceptT Error IO b - performHttpReq httpReq Query {} = do - res <- httpLbs' httpReq - unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) - where - predicate v = lessFetchCount (V.length v) l +executeRequestWithMgr' mgr = executeRequestWithMgr mgr () -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- @@ -302,9 +302,9 @@ class Accept mt => ParseResponse (mt :: MediaType *) a where -- | Parse API response. -- -- @ --- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- parseResponse :: 'FromJSON' a => 'HTTP.Response' 'LBS.ByteString' -> 'Either' 'Error' a -- @ -parseResponseJSON :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m 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 @@ -349,9 +349,9 @@ instance b ~ URI => ParseResponse 'MtRedirect b where -- | Helper for handling of 'RequestRedirect'. -- -- @ --- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- parseRedirect :: 'HTTP.Response' 'LBS.ByteString' -> 'Either' 'Error' a -- @ -parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI +parseRedirect :: MonadError Error m => URI -> HTTP.Response LBS.ByteString -> m URI parseRedirect originalUri rsp = do let status = responseStatus rsp when (statusCode status /= 302) $ @@ -501,7 +501,7 @@ makeHttpRequest auth r = case r of setBody body req = req { requestBody = RequestBodyLBS body } -- | 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 @@ -516,25 +516,27 @@ getNextUrl req = do -- | 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 mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) - => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> (a -> Bool) -- ^ predicate to continue iteration - -> HTTP.Request -- ^ initial request - -> Tagged mt (m a) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> (a -> Bool) -- ^ predicate to continue iteration + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a)) performPagedRequest httpLbs' predicate initReq = Tagged $ do res <- httpLbs' initReq m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) go m res initReq where - go :: a -> 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 @@ -542,7 +544,7 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do res' <- httpLbs' req' m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' - (_, _) -> return acc + (_, _) -> return (acc <$ res) ------------------------------------------------------------------------------- -- Internal From e4ddc1ab3a0e8c7830ca1d682faf4c8eff71fbcf Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Fri, 3 Jan 2020 15:59:36 -0800 Subject: [PATCH 204/309] Add support for the comment reply endpoint --- src/GitHub/Data/Comments.hs | 12 ++++++++++++ src/GitHub/Endpoints/PullRequests/Comments.hs | 11 +++++++++++ 2 files changed, 23 insertions(+) diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 91c6d4e5..cb52b04b 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -83,3 +83,15 @@ instance ToJSON NewPullComment where , "path" .= path , "position" .= pos ] + +data PullCommentReply = PullCommentReply + { pullCommentReplyBody :: Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullCommentReply where rnf = genericRnf + +instance ToJSON PullCommentReply where + toJSON (PullCommentReply b) = + object [ "body" .= b + ] diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 889de642..9bb6fca2 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -9,6 +9,7 @@ module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsR, pullRequestCommentR, createPullCommentR, + createPullCommentReplyR, module GitHub.Data, ) where @@ -36,3 +37,13 @@ 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"] From e712718ff99c1846391ebed9c38ebfb70f7844fa Mon Sep 17 00:00:00 2001 From: Ruud van Asseldonk Date: Thu, 9 Jan 2020 13:32:03 +0100 Subject: [PATCH 205/309] Add support for collaborator permission endpoint This endpoint allows checking whether a collaborator has read, write, or admin permissions. We are using this endpoint in [1], from this branch, and so far it has been working fine. [1]: https://github.com/channable/hoff --- src/GitHub.hs | 1 + src/GitHub/Data/Repos.hs | 41 +++++++++++++++++++++ src/GitHub/Endpoints/Repos/Collaborators.hs | 11 ++++++ 3 files changed, 53 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index 2faf1618..0c0abc3d 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -258,6 +258,7 @@ module GitHub ( -- ** Collaborators -- | See collaboratorsOnR, + collaboratorPermissionOnR, isCollaboratorOnR, addCollaboratorR, diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 8486fb6a..d9c9cf1b 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -20,6 +20,7 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) #else @@ -158,6 +159,27 @@ contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url +-- | The permission of a collaborator on a repository. +-- See +data CollaboratorPermission + = CollaboratorPermissionAdmin + | CollaboratorPermissionWrite + | CollaboratorPermissionRead + | CollaboratorPermissionNone + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData CollaboratorPermission where rnf = genericRnf +instance Binary CollaboratorPermission + +-- | A collaborator and its permission on a repository. +-- See +data CollaboratorWithPermission + = CollaboratorWithPermission SimpleUser CollaboratorPermission + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CollaboratorWithPermission where rnf = genericRnf +instance Binary CollaboratorWithPermission + -- JSON instances instance FromJSON Repo where @@ -303,3 +325,22 @@ 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/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index bc5680c6..5322b36d 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -7,6 +7,7 @@ -- . module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOnR, + collaboratorPermissionOnR, isCollaboratorOnR, addCollaboratorR, module GitHub.Data, @@ -22,6 +23,16 @@ collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector S collaboratorsOnR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] +-- | Review a user's permission level. +-- +collaboratorPermissionOnR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator to check permissions of. + -> GenRequest 'MtJSON rw CollaboratorWithPermission +collaboratorPermissionOnR owner repo coll = + query ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll, "permission"] [] + -- | Check if a user is a collaborator. -- See isCollaboratorOnR From 3cb9b2343fc7a23009aaa897e7944cee73e5f116 Mon Sep 17 00:00:00 2001 From: vrom911 Date: Mon, 10 Feb 2020 19:00:39 +0000 Subject: [PATCH 206/309] Use IssueNumber in editIssueR and issueR --- spec/GitHub/IssuesSpec.hs | 5 +++++ src/GitHub/Endpoints/Issues.hs | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index cfad56e3..2ed08278 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -38,6 +38,11 @@ spec = 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 "phadej" "github" (GitHub.IssueNumber 428) + resIss `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index d2b24e69..f1980dbf 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -33,7 +33,7 @@ organizationIssuesR org 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] [] @@ -63,6 +63,6 @@ editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- See -editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue +editIssueR :: Name Owner -> Name Repo -> IssueNumber -> EditIssue -> Request 'RW Issue editIssueR user repo iss = command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode From 7d9fcbaed66dd2ac742d4d8c06ec20de0a0bf312 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Tue, 11 Feb 2020 23:48:53 +1100 Subject: [PATCH 207/309] Housekeeping for data and endpoint exports - Add missing data and endpoint exports - Move statuses exports under repositories - Remove duplicated enterprise exports --- src/GitHub.hs | 38 ++++++++++++++++++++++++-------------- src/GitHub/Data.hs | 4 +++- 2 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index e2220376..087a72d1 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -56,14 +56,6 @@ module GitHub ( watchersForR, reposWatchedByR, - -- * Enterprise - -- | See - - -- ** Organizations - -- | See - createOrganizationR, - renameOrganizationR, - -- * Gists -- | See -- @@ -289,6 +281,15 @@ module GitHub ( commitR, diffR, + -- ** Contents + -- | See + contentsForR, + readmeForR, + archiveForR, + createFileR, + updateFileR, + deleteFileR, + -- ** Deploy Keys -- | See deployKeysForR, @@ -316,6 +317,12 @@ module GitHub ( -- * Create a fork forksForR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- ** Webhooks -- | See webhooksForR, @@ -389,11 +396,13 @@ module GitHub ( usersFollowingR, usersFollowedByR, - -- ** Statuses - -- | See - createStatusR, - statusesForR, - statusForR, + -- ** Git SSH Keys + -- | See + publicSSHKeysR, + publicSSHKeysForR, + publicSSHKeyR, + createUserPublicSSHKeyR, + deleteUserPublicSSHKeyR, -- ** Rate Limit -- | See @@ -410,7 +419,6 @@ import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching -import GitHub.Endpoints.Enterprise.Organizations import GitHub.Endpoints.Gists import GitHub.Endpoints.Gists.Comments import GitHub.Endpoints.GitData.Blobs @@ -433,6 +441,7 @@ 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 @@ -444,4 +453,5 @@ 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/Data.hs b/src/GitHub/Data.hs index 6acc0bf2..6b475d40 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -59,7 +59,8 @@ module GitHub.Data ( module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, - module GitHub.Data.Webhooks + module GitHub.Data.Webhooks, + module GitHub.Data.Webhooks.Validate, ) where import GitHub.Internal.Prelude @@ -94,6 +95,7 @@ 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 From b9d2d1ba2326d417d1dcbbc4ce225835af76a108 Mon Sep 17 00:00:00 2001 From: Ali Abrar Date: Fri, 14 Feb 2020 10:37:53 -0500 Subject: [PATCH 208/309] Add draft option to mergeable state --- src/GitHub/Data/Options.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 9ef2be6a..70665317 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -98,6 +98,7 @@ data MergeableState | StateUnstable | StateBlocked | StateBehind + | StateDraft deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -108,6 +109,7 @@ instance ToJSON MergeableState where 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 @@ -117,6 +119,7 @@ instance FromJSON MergeableState where "unstable" -> pure StateUnstable "blocked" -> pure StateBlocked "behind" -> pure StateBehind + "draft" -> pure StateDraft _ -> fail $ "Unknown MergeableState: " <> T.unpack t instance NFData MergeableState where rnf = genericRnf From dce8c7fe404083b1ddad5c665f0e7e7cb4dddf8b Mon Sep 17 00:00:00 2001 From: Victor Nawothnig Date: Sat, 15 Feb 2020 02:10:00 +0100 Subject: [PATCH 209/309] Add missing tick --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 45492903..cc825f98 100644 --- a/README.md +++ b/README.md @@ -68,7 +68,7 @@ import qualified GitHub main :: IO () main = do - possibleUsers <- github GitHub.usersFollowingR "phadej" + possibleUsers <- github' GitHub.usersFollowingR "phadej" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers From e6163c44ab932671219b5595fd9bac5afc8b5745 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 18 Feb 2020 21:37:36 +0200 Subject: [PATCH 210/309] Add recent PRs to Changelog --- CHANGELOG.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8d776cb8..52400168 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,18 @@ This reduces symbol bloat in the library. [#421](https://github.com/phadej/github/pull/421) - Add label descriptions [#418](https://github.com/phadej/github/pull/418) +- Add "draft" option to mergeable state + [#431](https://github.com/phadej/github/pull/431) +- Use IssueNumber in editIssueR and issueR + [#429](https://github.com/phadej/github/pull/429) +- Manage orgs in GitHub Enterprise + [#420](https://github.com/phadej/github/pull/420) +- Add support for collaborator permission endpoint + [#425](https://github.com/phadej/github/pull/425) +- Add support for the comment reply endpoint + [#424](Add support for the comment reply endpoint) +- Organise exports in `GitHub` + [#430](https://github.com/phadej/github/pull/430) ## Changes for 0.23 From 807d74c5ecb5f9c30a75dd15af526a6103bff9cc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 18 Feb 2020 21:44:14 +0200 Subject: [PATCH 211/309] Export createPullCommentReplyR, --- src/GitHub.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index 087a72d1..62c1ea6d 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -223,6 +223,7 @@ module GitHub ( pullRequestCommentsR, pullRequestCommentR, createPullCommentR, + createPullCommentReplyR, -- ** Pull request reviews -- | See From b924756659ccb930a070c6c5fa05c070611c86d2 Mon Sep 17 00:00:00 2001 From: Alexandre Esteves <2335822+alexfmpe@users.noreply.github.com> Date: Tue, 21 Apr 2020 20:45:43 +0100 Subject: [PATCH 212/309] Fix typo --- src/GitHub/Request.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index b72d25be..f0724d2c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -31,7 +31,7 @@ -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( - -- * A convinient execution of requests + -- * A convenient execution of requests github, github', GitHubRW, @@ -121,10 +121,10 @@ import GitHub.Data.Request import Paths_github (version) ------------------------------------------------------------------------------- --- Convinience +-- Convenience ------------------------------------------------------------------------------- --- | A convinience function to turn functions returning @'Request' rw x@, +-- | A convenience function to turn functions returning @'Request' rw x@, -- into functions returning @IO (Either 'Error' x)@. -- -- >>> :t \auth -> github auth userInfoForR From c705c34e9fcdfc8e787fba95150eb9cceb02afd2 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Mon, 27 Apr 2020 22:46:27 -0700 Subject: [PATCH 213/309] Generalize PagedQuery to allow queries of any foldable semigroup. --- src/GitHub/Data/Request.hs | 2 +- src/GitHub/Request.hs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 04f38339..4180a938 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -154,7 +154,7 @@ instance IReadOnly 'RA where iro = ROA -- /Note:/ 'Request' is not 'Functor' on purpose. data GenRequest (mt :: MediaType *) (rw :: RW) a where Query :: Paths -> QueryString -> GenRequest mt rw a - PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) + PagedQuery :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a -- | Command Command diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index f0724d2c..4f58fa61 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -100,7 +100,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP @@ -242,7 +241,7 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do performHttpReq httpReq (PagedQuery _ _ l) = unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) where - predicate v = lessFetchCount (V.length v) l + predicate v = lessFetchCount (length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq From f3765823d99ed99111415e0af9b0cf3c9e4a0c5a Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Fri, 15 May 2020 08:55:31 +0200 Subject: [PATCH 214/309] add endpoint for users search --- spec/GitHub/SearchSpec.hs | 12 ++++++++++-- src/GitHub.hs | 5 +---- src/GitHub/Endpoints/Search.hs | 7 +++++++ 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index ce82900d..5cc5a15f 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -16,8 +16,9 @@ import qualified Data.Vector as V import GitHub (github) import GitHub.Data - (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR) + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), + SimpleUser (..), User, mkId) +import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -57,3 +58,10 @@ spec = do issues <- searchResultResults . fromRightS <$> github auth searchIssuesR query 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 <- searchResultResults . fromRightS <$> github auth searchUsersR query + length users `shouldBe` 1 + simpleUserId (V.head users) `shouldBe` mkId (Proxy :: Proxy User) 51087 diff --git a/src/GitHub.hs b/src/GitHub.hs index 62c1ea6d..7fdcc111 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -355,13 +355,10 @@ module GitHub ( -- * Search -- | See - -- - -- Missing endpoints: - -- - -- * Search users searchReposR, searchCodeR, searchIssuesR, + searchUsersR, -- * Users -- | See diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 26c134bd..3fb50e85 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -9,6 +9,7 @@ module GitHub.Endpoints.Search( searchReposR, searchCodeR, searchIssuesR, + searchUsersR, module GitHub.Data, ) where @@ -35,3 +36,9 @@ searchCodeR searchString = searchIssuesR :: Text -> Request k (SearchResult Issue) searchIssuesR searchString = query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + +-- | Search users. +-- See +searchUsersR :: Text -> Request k (SearchResult SimpleUser) +searchUsersR searchString = + query ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] From 3a3f3b8a36d78d050bb7fb7f87b8dc74ce8f2877 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Mon, 25 May 2020 13:55:07 +0200 Subject: [PATCH 215/309] Organizations: allow listing outside collaborators --- github.cabal | 1 + src/GitHub.hs | 6 ++++++ .../Organizations/OutsideCollaborators.hs | 21 +++++++++++++++++++ 3 files changed, 28 insertions(+) create mode 100644 src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs diff --git a/github.cabal b/github.cabal index 643fcbb0..8ebe2b39 100644 --- a/github.cabal +++ b/github.cabal @@ -132,6 +132,7 @@ 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.Comments diff --git a/src/GitHub.hs b/src/GitHub.hs index 62c1ea6d..a5d7f454 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -175,6 +175,11 @@ module GitHub ( membersOfWithR, isMemberOfR, orgInvitationsR, + -- ** Outside Collaborators + -- | See + -- + -- Missing endpoints: All except /Outside Collaborator List/ + outsideCollaboratorsR, -- ** Teams -- | See @@ -433,6 +438,7 @@ import GitHub.Endpoints.Issues.Labels import GitHub.Endpoints.Issues.Milestones import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members +import GitHub.Endpoints.Organizations.OutsideCollaborators import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs new file mode 100644 index 00000000..9bc392dd --- /dev/null +++ b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- 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"] [] From 1484325f652a1178e2a0bb6c5ef25da28d79820e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 18 Feb 2020 22:19:39 +0200 Subject: [PATCH 216/309] Bump version --- CHANGELOG.md | 42 +++++++++++++++++++++++++++--------------- github.cabal | 2 +- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 52400168..51e42146 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,19 +1,14 @@ -## Changes for 0.24 - -**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. +## Changes for 0.26 -This reduces symbol bloat in the library. -[#415](https://github.com/phadej/github/pull/415) +- Generalize PagedQuery to allow its reuse by preview github APIs + [#439](https://github.com/phadej/github/pull/439) +- Add endpoint for listing organizations outside collaborators + [#445](https://github.com/phadej/github/pull/445) +- Add endpoint for users search + [#444](https://github.com/phadej/github/pull/444) + +## Changes for 0.25 -- Remove double `withOpenSSL` - [#414](https://github.com/phadej/github/pull/414) -- Pull requests reviews API uses issue number - [#409](https://github.com/phadej/github/pull/409) -- Update `Repo`, `NewRepo` and `EditRepo` data types - [#407](https://github.com/phadej/github/pull/407) - Add `executeRequestWithMgrAndRes` [#421](https://github.com/phadej/github/pull/421) - Add `limitsFromHttpResponse` @@ -29,10 +24,27 @@ This reduces symbol bloat in the library. - Add support for collaborator permission endpoint [#425](https://github.com/phadej/github/pull/425) - Add support for the comment reply endpoint - [#424](Add support for the comment reply endpoint) + [#424](https://github.com/phadej/github/pull/424) - Organise exports in `GitHub` [#430](https://github.com/phadej/github/pull/430) +## Changes for 0.24 + +**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/phadej/github/pull/415) + +- Remove double `withOpenSSL` + [#414](https://github.com/phadej/github/pull/414) +- Pull requests reviews API uses issue number + [#409](https://github.com/phadej/github/pull/409) +- Update `Repo`, `NewRepo` and `EditRepo` data types + [#407](https://github.com/phadej/github/pull/407) + ## Changes for 0.23 - Escape URI paths diff --git a/github.cabal b/github.cabal index 8ebe2b39..1ff2e5ea 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.24 +version: 0.26 synopsis: Access to the GitHub API, v3. category: Network description: From 59f9efe12c30960c3f435362d6cf026c5489b1e7 Mon Sep 17 00:00:00 2001 From: Doug Beardsley Date: Fri, 17 Apr 2020 07:58:33 -0400 Subject: [PATCH 217/309] Make repoWebhookResponseStatus optional I have encountered situations where the `repoWebhookResponseStatus` field returned by GitHub is `null` (in my case it was in last_response). When this happens, I get the following error: ``` ParseError "Error in $[1]['last_response'].status: expected Text, encountered Null" ``` Unfortunately I can't find anything in the documentation (https://developer.github.com/v3/repos/hooks/) indicating that the status field is nullable. At any rate, this PR fixes the problem for me. --- CHANGELOG.md | 3 +++ src/GitHub/Data/Webhooks.hs | 6 +++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 51e42146..12f7575f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,9 @@ [#445](https://github.com/phadej/github/pull/445) - Add endpoint for users search [#444](https://github.com/phadej/github/pull/444) +- Make repoWebhookResponseStatus optional + [#436](https://github.com/phadej/github/pull/436) + ## Changes for 0.25 diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index e58f8e69..fb81969d 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -89,7 +89,7 @@ instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) - , repoWebhookResponseStatus :: !Text + , repoWebhookResponseStatus :: !(Maybe Text) , repoWebhookResponseMessage :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -254,8 +254,8 @@ instance FromJSON RepoWebhook where instance FromJSON RepoWebhookResponse where parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse <$> o .: "code" - <*> o .: "status" - <*> o .: "message" + <*> o .:? "status" + <*> o .:? "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name From 5b12b032ba7a22948558b993f270d308ce9375cb Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Tue, 3 Dec 2019 22:26:22 +1100 Subject: [PATCH 218/309] Fix permission field in types for teams Add privacy field to types for teams The privacy field was previously commented out while the privacy level of a team was part of the `ironman` API preview. This feature is now part of the official v3 API, so this commit adds support for this field. Make privacy field non-optional in teams The `privacy` field is optional when creating/editing teams, but has a context dependent default value. When getting the team details, the field is expected to always be populated due to these default values. Update team privacy/permission optionality Makes team `privacy` and `permission` fields required when creating a team so users are forced to choose, but optional when editing a team. Filter null values from types for teams --- CHANGELOG.md | 2 + samples/Organizations/Teams/CreateTeamFor.hs | 2 +- samples/Teams/EditTeam.hs | 2 +- src/GitHub/Data/Teams.hs | 48 ++++++++++++-------- 4 files changed, 33 insertions(+), 21 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 12f7575f..7d59fa1f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,8 @@ [#444](https://github.com/phadej/github/pull/444) - Make repoWebhookResponseStatus optional [#436](https://github.com/phadej/github/pull/436) +- Teams improvements + [#417](https://github.com/phadej/github/pull/417) ## Changes for 0.25 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/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index bb0a05ca..7e83e5c9 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -15,7 +15,7 @@ main = do (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/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 387318e0..79ef9706 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -50,7 +50,7 @@ data SimpleTeam = SimpleTeam , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. , simpleTeamSlug :: !(Name Team) , simpleTeamDescription :: !(Maybe Text) - , simpleTeamPrivacy :: !(Maybe Privacy) + , simpleTeamPrivacy :: !Privacy , simpleTeamPermission :: !Permission , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL @@ -66,7 +66,7 @@ data Team = Team , teamName :: !Text , teamSlug :: !(Name Team) , teamDescription :: !(Maybe Text) - , teamPrivacy :: !(Maybe Privacy) + , teamPrivacy :: !Privacy , teamPermission :: !Permission , teamMembersUrl :: !URL , teamRepositoriesUrl :: !URL @@ -83,8 +83,8 @@ data CreateTeam = CreateTeam { createTeamName :: !(Name Team) , createTeamDescription :: !(Maybe Text) , createTeamRepoNames :: !(Vector (Name Repo)) - -- , createTeamPrivacy :: Privacy - , createTeamPermission :: Permission + , createTeamPrivacy :: !Privacy + , createTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -94,8 +94,8 @@ instance Binary CreateTeam data EditTeam = EditTeam { editTeamName :: !(Name Team) , editTeamDescription :: !(Maybe Text) - -- , editTeamPrivacy :: Privacy - , editTeamPermission :: !Permission + , editTeamPrivacy :: !(Maybe Privacy) + , editTeamPermission :: !(Maybe Permission) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -144,7 +144,7 @@ instance FromJSON SimpleTeam where <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -156,7 +156,7 @@ instance FromJSON Team where <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -165,19 +165,29 @@ instance FromJSON Team where <*> 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 From ebc378a6b0453796606136ae2f9d47576fcd846b Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 18 Jun 2019 19:26:15 -0400 Subject: [PATCH 219/309] Change gitReferenceRef type to Name GitReference --- src/GitHub/Data/GitData.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index bce1cb52..fa9973d1 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -156,7 +156,7 @@ instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject , gitReferenceUrl :: !URL - , gitReferenceRef :: !Text + , gitReferenceRef :: !(Name GitReference) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From 9db8cf11dc4f2af5334800d99649872954b7ead7 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 18 Jun 2019 12:32:02 -0400 Subject: [PATCH 220/309] Add deleteReference --- CHANGELOG.md | 3 ++- src/GitHub.hs | 2 ++ src/GitHub/Endpoints/GitData/References.hs | 7 +++++++ 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7d59fa1f..991d24c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,7 +10,8 @@ [#436](https://github.com/phadej/github/pull/436) - Teams improvements [#417](https://github.com/phadej/github/pull/417) - +- Add deleteReference endpoint + [#388](https://github.com/phadej/github/pull/388) ## Changes for 0.25 diff --git a/src/GitHub.hs b/src/GitHub.hs index 646ecd98..6b5f8d36 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -100,6 +100,8 @@ module GitHub ( referenceR, referencesR, createReferenceR, + deleteReferenceR, + namespacedReferencesR, -- ** Trees -- | See diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 270d8805..bf64657f 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -10,6 +10,7 @@ module GitHub.Endpoints.GitData.References ( referenceR, referencesR, createReferenceR, + deleteReferenceR, namespacedReferencesR, module GitHub.Data, ) where @@ -36,6 +37,12 @@ createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW Gi createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) +-- | Delete a reference. +-- See +deleteReferenceR :: Name Owner -> Name Repo -> Name GitReference -> GenRequest 'MtUnit 'RW () +deleteReferenceR user repo ref = + Command Delete ["repos", toPathPart user, toPathPart repo , "git", "refs", toPathPart ref] mempty + -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] From 878a452590dc00ac337d8390d1940f97be2d25c3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 May 2020 22:32:00 +0300 Subject: [PATCH 221/309] Prepare for 0.26 --- .travis.yml | 109 +++++++++++++++++++---------------- github.cabal | 11 ++-- samples/github-samples.cabal | 3 +- 3 files changed, 67 insertions(+), 56 deletions(-) diff --git a/.travis.yml b/.travis.yml index 594e2d55..69a83ce4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,11 +2,17 @@ # # haskell-ci '--config=cabal.haskell-ci' '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.5.20190908 +# version: 0.10.1 # +version: ~> 1.0 language: c +os: linux dist: xenial git: # whether to recursively clone submodules @@ -18,6 +24,7 @@ cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store + - $HOME/.hlint before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' @@ -27,22 +34,32 @@ before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $CABALHOME/packages/head.hackage -matrix: +jobs: include: - - compiler: ghc-8.8.1 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} + - compiler: ghc-8.10.1 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}} + os: linux + - compiler: ghc-8.8.3 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.6.5 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.4.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.2.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.0.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}} + os: linux - compiler: ghc-7.10.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.2"]}} + os: linux - compiler: ghc-7.8.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.2"]}} + os: linux before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - WITHCOMPILER="-w $HC" @@ -55,29 +72,8 @@ before_install: - TOP=$(pwd) - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - - CABAL="$CABAL -vnormal+nowrap+markoutput" + - CABAL="$CABAL -vnormal+nowrap" - set -o pipefail - - | - echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk - echo 'BEGIN { state = "output"; }' >> .colorful.awk - echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk - echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk - echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk - echo ' if (state == "cabal") {' >> .colorful.awk - echo ' print blue($0)' >> .colorful.awk - echo ' } else {' >> .colorful.awk - echo ' print $0' >> .colorful.awk - echo ' }' >> .colorful.awk - echo '}' >> .colorful.awk - - cat .colorful.awk - - | - color_cabal_output () { - awk -f $TOP/.colorful.awk - } - - echo text | color_cabal_output -install: - - ${CABAL} --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks - HEADHACKAGE=false @@ -98,6 +94,9 @@ install: echo " prefix: $CABALHOME" >> $CABALHOME/config echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config +install: + - ${CABAL} --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - | echo "program-default-options" >> $CABALHOME/config echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config @@ -110,25 +109,30 @@ install: - | echo "packages: ." >> cabal.project echo "packages: samples" >> cabal.project + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "optimization: False" >> cabal.project + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "constraints: github-samples +openssl" >> cabal.project + echo "optimization: False" >> cabal.project - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - if [ -f "samples/configure.ac" ]; then (cd "samples" && autoreconf -i); fi - - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output + - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all + - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... - - ${CABAL} v2-sdist all | color_cabal_output + - ${CABAL} v2-sdist all # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false @@ -142,30 +146,35 @@ script: - | echo "packages: ${PKGDIR_github}" >> cabal.project echo "packages: ${PKGDIR_github_samples}" >> cabal.project + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "optimization: False" >> cabal.project + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "constraints: github-samples +openssl" >> cabal.project + echo "optimization: False" >> cabal.project - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building... # this builds all libraries and executables (without tests/benchmarks) - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all # Building with tests and benchmarks... # build & run tests, build benchmarks - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all # Testing... - - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all # cabal check... - (cd ${PKGDIR_github} && ${CABAL} -vnormal check) - (cd ${PKGDIR_github_samples} && ${CABAL} -vnormal check) # haddock... - - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi + - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi # Building without installed constraints for packages in global-db... - rm -f cabal.project.local - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all -# REGENDATA ["--config=cabal.haskell-ci","cabal.project"] +# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","cabal.project"]) # EOF diff --git a/github.cabal b/github.cabal index 1ff2e5ea..ed0045b0 100644 --- a/github.cabal +++ b/github.cabal @@ -36,7 +36,8 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.1 + || ==8.8.3 + || ==8.10.1 extra-source-files: README.md @@ -163,7 +164,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.14 + base >=4.7 && <4.15 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 @@ -175,15 +176,15 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.5 - , base-compat >=0.10.4 && <0.12 + aeson >=1.4.0.0 && <1.6 + , base-compat >=0.11.1 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 - , http-client >=0.5.12 && <0.7 + , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.1 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index ae4fb3f2..41d6dccf 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -15,7 +15,8 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.1 + || ==8.8.3 + || ==8.10.1 library hs-source-dirs: src From 5277e66ad07b37e0745c18c2370ea7d74ec02b4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Mon, 20 Jul 2020 13:47:23 +0200 Subject: [PATCH 222/309] typos --- src/GitHub/Data/Definitions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 8da8b761..0d56171b 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -121,7 +121,7 @@ data Organization = Organization instance NFData Organization where rnf = genericRnf 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) From f5c0dd6be826f3beb10924da829c0e210c00ac33 Mon Sep 17 00:00:00 2001 From: Alexandre Esteves <2335822+alexfmpe@users.noreply.github.com> Date: Tue, 28 Jul 2020 11:23:29 +0100 Subject: [PATCH 223/309] Fix typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index cc825f98..d6996412 100644 --- a/README.md +++ b/README.md @@ -42,7 +42,7 @@ For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). -Request functions (ending with `R`) construct a data type with can be executed +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. From 514b175851dd7c4a9722ff203dd6f652a15d33e8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 22 Oct 2020 13:09:14 +0300 Subject: [PATCH 224/309] Update dependencies 20201022 --- github.cabal | 4 ++-- src/GitHub/Request.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/github.cabal b/github.cabal index ed0045b0..1b4f2e40 100644 --- a/github.cabal +++ b/github.cabal @@ -178,14 +178,14 @@ library build-depends: aeson >=1.4.0.0 && <1.6 , base-compat >=0.11.1 && <0.12 - , base16-bytestring >=0.1.1.6 && <0.2 + , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.8 - , http-link-header >=1.0.3.1 && <1.1 + , 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 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 4f58fa61..808f33a7 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -90,7 +90,7 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) +import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, @@ -507,7 +507,7 @@ getNextUrl req = do 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) From f18d8ac45191c8cfa0105e8d364e994480b1df96 Mon Sep 17 00:00:00 2001 From: Jean-Paul Calderone Date: Wed, 2 Dec 2020 18:33:27 -0500 Subject: [PATCH 225/309] Add vector of SimpleTeam in "requested_teams" field of PullRequest --- .../pull-request-team-review-requested.json | 362 ++++++++++++++++++ spec/GitHub/PullRequestsSpec.hs | 18 + src/GitHub/Data/PullRequests.hs | 5 + 3 files changed, 385 insertions(+) create mode 100644 fixtures/pull-request-team-review-requested.json 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/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 14cbee9a..7a49bc97 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -65,6 +65,13 @@ spec = do 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 "phadej" "github" (GH.IssueNumber 14) @@ -97,16 +104,27 @@ spec = do 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 ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 5c2f62e1..0075986a 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -21,6 +21,7 @@ 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 () @@ -38,6 +39,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestBody :: !(Maybe Text) , simplePullRequestAssignees :: (Vector SimpleUser) , simplePullRequestRequestedReviewers :: (Vector SimpleUser) + , simplePullRequestRequestedTeamReviewers:: (Vector SimpleTeam) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -63,6 +65,7 @@ data PullRequest = PullRequest , pullRequestBody :: !(Maybe Text) , pullRequestAssignees :: (Vector SimpleUser) , pullRequestRequestedReviewers :: (Vector SimpleUser) + , pullRequestRequestedTeamReviewers :: (Vector SimpleTeam) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -198,6 +201,7 @@ instance FromJSON SimplePullRequest where <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -239,6 +243,7 @@ instance FromJSON PullRequest where <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From a6a76128dfdc99560cbdf7a42936087aae1120e9 Mon Sep 17 00:00:00 2001 From: Jean-Paul Calderone Date: Wed, 2 Dec 2020 19:20:15 -0500 Subject: [PATCH 226/309] Attempt to get the new data fixture where it needs to be --- github.cabal | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/github.cabal b/github.cabal index 1b4f2e40..d0fd875f 100644 --- a/github.cabal +++ b/github.cabal @@ -42,14 +42,7 @@ tested-with: extra-source-files: README.md CHANGELOG.md - fixtures/issue-search.json - fixtures/list-teams.json - fixtures/members-list.json - fixtures/pull-request-opened.json - fixtures/pull-request-review-requested.json - fixtures/user-organizations.json - fixtures/user.json - fixtures/user-bot.json + fixtures/*.json source-repository head type: git From b060eca8855010a3ba3bb2b17702343e1d54e437 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 14 Dec 2020 20:06:30 +0200 Subject: [PATCH 227/309] Use GitHub Actions --- .github/workflows/haskell-ci.yml | 181 +++++++++++++++++++++++++++++++ .travis.yml | 180 ------------------------------ 2 files changed, 181 insertions(+), 180 deletions(-) create mode 100644 .github/workflows/haskell-ci.yml delete mode 100644 .travis.yml diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml new file mode 100644 index 00000000..2dd020d0 --- /dev/null +++ b/.github/workflows/haskell-ci.yml @@ -0,0 +1,181 @@ +# 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.11.20201213 +# +# REGENDATA ("0.11.20201213",["--config=cabal.haskell-ci","github","cabal.project"]) +# +name: Haskell-CI +on: + push: + branches: + - master + pull_request: + branches: + - master +jobs: + linux: + name: Haskell-CI Linux + runs-on: ubuntu-18.04 + container: + image: buildpack-deps:bionic + strategy: + matrix: + include: + - ghc: 8.10.1 + - ghc: 8.8.3 + - ghc: 8.6.5 + - ghc: 8.4.4 + - ghc: 8.2.2 + - ghc: 8.0.2 + - ghc: 7.10.3 + - ghc: 7.8.4 + fail-fast: false + steps: + - name: apt + run: | + apt-get update + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common + apt-add-repository -y 'ppa:hvr/ghc' + apt-get update + apt-get install -y ghc-$GHC_VERSION cabal-install-3.2 + env: + GHC_VERSION: ${{ matrix.ghc }} + - 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 + HC=/opt/ghc/$GHC_VERSION/bin/ghc + echo "HC=$HC" >> $GITHUB_ENV + echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV + echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV + echo "CABAL=/opt/cabal/3.2/bin/cabal -vnormal+nowrap" >> $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 + echo "ARG_COMPILER=--ghc --with-compiler=/opt/ghc/$GHC_VERSION/bin/ghc" >> $GITHUB_ENV + echo "GHCJSARITH=0" >> $GITHUB_ENV + env: + GHC_VERSION: ${{ matrix.ghc }} + - name: env + run: | + env + - name: write cabal config + run: | + mkdir -p $CABAL_DIR + cat >> $CABAL_CONFIG < cabal-plan.xz + echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc 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 + - name: checkout + uses: actions/checkout@v2 + with: + path: source + - name: sdist + run: | + mkdir -p sdist + cd source || false + $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 + touch cabal.project + touch cabal.project.local + echo "packages: ${PKGDIR_github}" >> cabal.project + echo "packages: ${PKGDIR_github_samples}" >> cabal.project + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + cat >> cabal.project <=1.3 + constraints: semigroups ^>=0.19 + constraints: github +openssl + constraints: github-samples +openssl + optimization: False + EOF + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ 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: cache + uses: actions/cache@v2 + with: + key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} + path: ~/.cabal/store + restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- + - name: install dependencies + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only all + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only 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 + - 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 + cd ${PKGDIR_github_samples} || false + ${CABAL} -vnormal check + - name: haddock + run: | + if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock $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 diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 69a83ce4..00000000 --- a/.travis.yml +++ /dev/null @@ -1,180 +0,0 @@ -# This Travis job script has been generated by a script via -# -# haskell-ci '--config=cabal.haskell-ci' '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.10.1 -# -version: ~> 1.0 -language: c -os: linux -dist: xenial -git: - # whether to recursively clone submodules - submodules: false -branches: - only: - - master -cache: - directories: - - $HOME/.cabal/packages - - $HOME/.cabal/store - - $HOME/.hlint -before_cache: - - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log - # remove files that are regenerated by 'cabal update' - - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* - - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - - rm -rfv $CABALHOME/packages/head.hackage -jobs: - include: - - compiler: ghc-8.10.1 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.8.3 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.6.5 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.4.4 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.2.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.0.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}} - os: linux - - compiler: ghc-7.10.3 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.2"]}} - os: linux - - compiler: ghc-7.8.4 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.2"]}} - os: linux -before_install: - - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - - WITHCOMPILER="-w $HC" - - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - - HCPKG="$HC-pkg" - - unset CC - - CABAL=/opt/ghc/bin/cabal - - CABALHOME=$HOME/.cabal - - export PATH="$CABALHOME/bin:$PATH" - - TOP=$(pwd) - - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - - echo $HCNUMVER - - CABAL="$CABAL -vnormal+nowrap" - - set -o pipefail - - TEST=--enable-tests - - BENCH=--enable-benchmarks - - HEADHACKAGE=false - - rm -f $CABALHOME/config - - | - echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config - echo "remote-build-reporting: anonymous" >> $CABALHOME/config - echo "write-ghc-environment-files: always" >> $CABALHOME/config - echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config - echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config - echo "world-file: $CABALHOME/world" >> $CABALHOME/config - echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config - echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config - echo "installdir: $CABALHOME/bin" >> $CABALHOME/config - echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config - echo "store-dir: $CABALHOME/store" >> $CABALHOME/config - echo "install-dirs user" >> $CABALHOME/config - echo " prefix: $CABALHOME" >> $CABALHOME/config - echo "repository hackage.haskell.org" >> $CABALHOME/config - echo " url: http://hackage.haskell.org/" >> $CABALHOME/config -install: - - ${CABAL} --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - | - echo "program-default-options" >> $CABALHOME/config - echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config - - cat $CABALHOME/config - - rm -fv cabal.project cabal.project.local cabal.project.freeze - - travis_retry ${CABAL} v2-update -v - # Generate cabal.project - - rm -rf cabal.project cabal.project.local cabal.project.freeze - - touch cabal.project - - | - echo "packages: ." >> cabal.project - echo "packages: samples" >> cabal.project - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "constraints: github-samples +openssl" >> cabal.project - echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - - if [ -f "samples/configure.ac" ]; then (cd "samples" && autoreconf -i); fi - - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} - - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - - rm cabal.project.freeze - - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all - - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all -script: - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - # Packaging... - - ${CABAL} v2-sdist all - # Unpacking... - - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} || false - - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; - - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; - - PKGDIR_github="$(find . -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" - - PKGDIR_github_samples="$(find . -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" - # Generate cabal.project - - rm -rf cabal.project cabal.project.local cabal.project.freeze - - touch cabal.project - - | - echo "packages: ${PKGDIR_github}" >> cabal.project - echo "packages: ${PKGDIR_github_samples}" >> cabal.project - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "constraints: github-samples +openssl" >> cabal.project - echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - # Building... - # this builds all libraries and executables (without tests/benchmarks) - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all - # Building with tests and benchmarks... - # build & run tests, build benchmarks - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all - # Testing... - - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all - # cabal check... - - (cd ${PKGDIR_github} && ${CABAL} -vnormal check) - - (cd ${PKGDIR_github_samples} && ${CABAL} -vnormal check) - # haddock... - - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi - # Building without installed constraints for packages in global-db... - - rm -f cabal.project.local - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all - -# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","cabal.project"]) -# EOF From c7960f4eea56365bf10239a61ebc45b7ce24cc9d Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Thu, 31 Dec 2020 01:20:48 +0900 Subject: [PATCH 228/309] Add endpoint to create gist --- src/GitHub.hs | 2 +- src/GitHub/Data/Gists.hs | 29 +++++++++++++++++++++++++++++ src/GitHub/Endpoints/Gists.hs | 6 ++++++ 3 files changed, 36 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 6b5f8d36..e00a53cb 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -62,7 +62,6 @@ module GitHub ( -- Missing endpoints: -- -- * Query a specific revision of a gist - -- * Create a gist -- * Edit a gist -- * List gist commits -- * Check if a gist is starred @@ -70,6 +69,7 @@ module GitHub ( -- * List gist forks gistsR, gistR, + createGistR, starGistR, unstarGistR, deleteGistR, diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 3e1fbe79..04c98bae 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -89,3 +89,32 @@ instance FromJSON GistComment where <*> o .: "body" <*> o .: "updated_at" <*> o .: "id" + +data NewGist = NewGist + { newGistDescription :: !Text + , newGistFiles :: !(HashMap Text NewGistFile) + , newGistPublic :: !Bool + } deriving (Show, Data, Typeable, Eq, Generic) + +instance NFData NewGist where rnf = genericRnf +instance Binary NewGist + +instance ToJSON NewGist where + toJSON (NewGist { newGistDescription = description + , newGistFiles = files + , newGistPublic = public + }) = object + [ "description" .= description + , "files" .= files + , "public" .= public + ] + +data NewGistFile = NewGistFile + { newGistFileContent :: !Text + } deriving (Show, Data, Typeable, Eq, Generic) + +instance NFData NewGistFile where rnf = genericRnf +instance Binary NewGistFile + +instance ToJSON NewGistFile where + toJSON (NewGistFile c) = object ["content" .= c] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 783e0588..de8e6c20 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -7,6 +7,7 @@ module GitHub.Endpoints.Gists ( gistsR, gistR, + createGistR, starGistR, unstarGistR, deleteGistR, @@ -28,6 +29,11 @@ gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] +-- | Create a new gist +-- See +createGistR :: NewGist -> Request 'RW Gist +createGistR ngist = command Post ["gists"] (encode ngist) + -- | Star a gist by the authenticated user. -- See starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () From 91424a994ab2a3c353e5356e065c341c3c638b83 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Fri, 1 Jan 2021 12:30:19 +0900 Subject: [PATCH 229/309] Refactor: remove brackets that are redundant --- src/GitHub/Data/Gists.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 04c98bae..b9402943 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -100,14 +100,14 @@ instance NFData NewGist where rnf = genericRnf instance Binary NewGist instance ToJSON NewGist where - toJSON (NewGist { newGistDescription = description - , newGistFiles = files - , newGistPublic = public - }) = object - [ "description" .= description - , "files" .= files - , "public" .= public - ] + toJSON NewGist { newGistDescription = description + , newGistFiles = files + , newGistPublic = public + } = object + [ "description" .= description + , "files" .= files + , "public" .= public + ] data NewGistFile = NewGistFile { newGistFileContent :: !Text From c44824bb6c41aad7fc9ac59e4686e138c9d67066 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Fri, 1 Jan 2021 15:10:37 +0900 Subject: [PATCH 230/309] Fix: use Maybe a for optional params with filter notNull --- src/GitHub/Data/Gists.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index b9402943..b6d1b673 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -91,9 +91,9 @@ instance FromJSON GistComment where <*> o .: "id" data NewGist = NewGist - { newGistDescription :: !Text + { newGistDescription :: !(Maybe Text) , newGistFiles :: !(HashMap Text NewGistFile) - , newGistPublic :: !Bool + , newGistPublic :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Generic) instance NFData NewGist where rnf = genericRnf @@ -103,11 +103,14 @@ instance ToJSON NewGist where toJSON NewGist { newGistDescription = description , newGistFiles = files , newGistPublic = public - } = object + } = object $ filter notNull [ "description" .= description , "files" .= files , "public" .= public ] + where + notNull (_, Null) = False + notNull (_, _) = True data NewGistFile = NewGistFile { newGistFileContent :: !Text From bf5f8fd3828698b28f5c307af6cc21ffe9fffb5b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 6 Mar 2021 23:34:15 +0200 Subject: [PATCH 231/309] Allow base-4.15 --- .github/workflows/haskell-ci.yml | 47 +++++++++++++++++++++++--------- cabal.project | 4 +++ github.cabal | 9 +++--- samples/github-samples.cabal | 5 ++-- 4 files changed, 46 insertions(+), 19 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 2dd020d0..637021b1 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.11.20201213 +# version: 0.11.20210222 # -# REGENDATA ("0.11.20201213",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.11.20210222",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -22,21 +22,32 @@ on: - master jobs: linux: - name: Haskell-CI Linux + name: Haskell-CI - Linux - GHC ${{ matrix.ghc }} runs-on: ubuntu-18.04 container: image: buildpack-deps:bionic + continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - ghc: 8.10.1 - - ghc: 8.8.3 + - ghc: 9.0.1 + allow-failure: false + - ghc: 8.10.4 + allow-failure: false + - ghc: 8.8.4 + allow-failure: false - ghc: 8.6.5 + allow-failure: false - ghc: 8.4.4 + allow-failure: false - ghc: 8.2.2 + allow-failure: false - ghc: 8.0.2 + allow-failure: false - ghc: 7.10.3 + allow-failure: false - ghc: 7.8.4 + allow-failure: false fail-fast: false steps: - name: apt @@ -45,7 +56,7 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common apt-add-repository -y 'ppa:hvr/ghc' apt-get update - apt-get install -y ghc-$GHC_VERSION cabal-install-3.2 + apt-get install -y ghc-$GHC_VERSION cabal-install-3.4 env: GHC_VERSION: ${{ matrix.ghc }} - name: Set PATH and environment variables @@ -58,12 +69,13 @@ jobs: echo "HC=$HC" >> $GITHUB_ENV echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV - echo "CABAL=/opt/cabal/3.2/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV + echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $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 - echo "ARG_COMPILER=--ghc --with-compiler=/opt/ghc/$GHC_VERSION/bin/ghc" >> $GITHUB_ENV + echo "HEADHACKAGE=false" >> $GITHUB_ENV + echo "ARG_COMPILER=--ghc --with-compiler=$HC" >> $GITHUB_ENV echo "GHCJSARITH=0" >> $GITHUB_ENV env: GHC_VERSION: ${{ matrix.ghc }} @@ -75,7 +87,7 @@ jobs: mkdir -p $CABAL_DIR cat >> $CABAL_CONFIG < $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@v2 with: path: source + - name: initial cabal.project for sdist + run: | + touch cabal.project + echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project + echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project + cat cabal.project - name: sdist run: | mkdir -p sdist - cd source || false $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist - name: unpack run: | @@ -138,6 +156,9 @@ jobs: constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl + allow-newer: deepseq-generics-0.2.0.0:base + allow-newer: deepseq-generics-0.2.0.0:ghc-prim + allow-newer: cryptohash-sha1-0.11.100.1:base optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local @@ -155,14 +176,14 @@ jobs: restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- - name: install dependencies run: | - $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only all - $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only all + $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 + $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 diff --git a/cabal.project b/cabal.project index 555119f5..5e40418a 100644 --- a/cabal.project +++ b/cabal.project @@ -9,3 +9,7 @@ constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl + +allow-newer: deepseq-generics-0.2.0.0:base +allow-newer: deepseq-generics-0.2.0.0:ghc-prim +allow-newer: cryptohash-sha1-0.11.100.1:base diff --git a/github.cabal b/github.cabal index 1b4f2e40..348a9345 100644 --- a/github.cabal +++ b/github.cabal @@ -27,7 +27,7 @@ maintainer: Oleg Grenrus homepage: https://github.com/phadej/github build-type: Simple copyright: - Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus + Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: GHC ==7.8.4 @@ -36,8 +36,9 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.3 - || ==8.10.1 + || ==8.8.4 + || ==8.10.4 + || ==9.0.1 extra-source-files: README.md @@ -164,7 +165,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.15 + base >=4.7 && <4.16 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 41d6dccf..270609d7 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -15,8 +15,9 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.3 - || ==8.10.1 + || ==8.8.4 + || ==8.10.4 + || ==9.0.1 library hs-source-dirs: src From 492735656d6a8efa4bf0ec4ce4cca1855327d78c Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 13 Sep 2021 18:51:27 +0200 Subject: [PATCH 232/309] Update RepoWebhookEvent --- src/GitHub/Data/Webhooks.hs | 52 +++++++++++++++++++++++++++---------- 1 file changed, 38 insertions(+), 14 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index fb81969d..8ca2fe8e 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -35,6 +35,7 @@ data RepoWebhookEvent = WebhookWildcardEvent | WebhookCheckRunEvent | WebhookCheckSuiteEvent + | WebhookCodeScanningAlert | WebhookCommitCommentEvent | WebhookContentReferenceEvent | WebhookCreateEvent @@ -42,12 +43,13 @@ data RepoWebhookEvent | WebhookDeployKeyEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent + | WebhookDiscussion + | WebhookDiscussionComment | WebhookDownloadEvent | WebhookFollowEvent | WebhookForkEvent - | WebhookForkApplyEvent - | WebhookGitHubAppAuthorizationEvent | WebhookGistEvent + | WebhookGitHubAppAuthorizationEvent | WebhookGollumEvent | WebhookInstallationEvent | WebhookInstallationRepositoriesEvent @@ -59,8 +61,9 @@ data RepoWebhookEvent | WebhookMembershipEvent | WebhookMetaEvent | WebhookMilestoneEvent - | WebhookOrganizationEvent | WebhookOrgBlockEvent + | WebhookOrganizationEvent + | WebhookPackage | WebhookPageBuildEvent | WebhookPingEvent | WebhookProjectCardEvent @@ -68,20 +71,25 @@ data RepoWebhookEvent | WebhookProjectEvent | WebhookPublicEvent | WebhookPullRequestEvent - | WebhookPullRequestReviewEvent | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestReviewEvent | WebhookPushEvent | WebhookRegistryPackageEvent | WebhookReleaseEvent + | WebhookRepositoryDispatch | WebhookRepositoryEvent | WebhookRepositoryImportEvent | WebhookRepositoryVulnerabilityAlertEvent + | WebhookSecretScanningAlert | WebhookSecurityAdvisoryEvent + | WebhookSponsorship | WebhookStarEvent | WebhookStatusEvent - | WebhookTeamEvent | WebhookTeamAddEvent + | WebhookTeamEvent | WebhookWatchEvent + | WebhookWorkflowDispatch + | WebhookWorkflowRun deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf @@ -137,6 +145,7 @@ instance FromJSON RepoWebhookEvent where "*" -> 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 @@ -144,12 +153,13 @@ instance FromJSON RepoWebhookEvent where "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 - "fork_apply" -> pure WebhookForkApplyEvent - "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent "gist" -> pure WebhookGistEvent + "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent "gollum" -> pure WebhookGollumEvent "installation" -> pure WebhookInstallationEvent "installation_repositories" -> pure WebhookInstallationRepositoriesEvent @@ -161,13 +171,14 @@ instance FromJSON RepoWebhookEvent where "membership" -> pure WebhookMembershipEvent "meta" -> pure WebhookMetaEvent "milestone" -> pure WebhookMilestoneEvent - "organization" -> pure WebhookOrganizationEvent "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 - "project" -> pure WebhookProjectEvent "public" -> pure WebhookPublicEvent "pull_request" -> pure WebhookPullRequestEvent "pull_request_review" -> pure WebhookPullRequestReviewEvent @@ -176,20 +187,26 @@ instance FromJSON RepoWebhookEvent where "registry_package" -> pure WebhookRegistryPackageEvent "release" -> pure WebhookReleaseEvent "repository" -> pure WebhookRepositoryEvent + "repository_dispatch" -> pure WebhookRepositoryDispatch "repository_import" -> pure WebhookRepositoryImportEvent "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent + "secret_scanning_alert" -> pure WebhookSecretScanningAlert "security_advisory" -> pure WebhookSecurityAdvisoryEvent + "sponsorship" -> pure WebhookSponsorship "star" -> pure WebhookStarEvent "status" -> pure WebhookStatusEvent "team" -> pure WebhookTeamEvent "team_add" -> pure WebhookTeamAddEvent "watch" -> pure WebhookWatchEvent + "workflow_dispatch" -> pure WebhookWorkflowDispatch + "workflow_run" -> pure WebhookWorkflowRun _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" toJSON WebhookCheckRunEvent = String "check_run" toJSON WebhookCheckSuiteEvent = String "check_suite" + toJSON WebhookCodeScanningAlert = String "code_scanning_alert" toJSON WebhookCommitCommentEvent = String "commit_comment" toJSON WebhookContentReferenceEvent = String "content_reference" toJSON WebhookCreateEvent = String "create" @@ -197,12 +214,13 @@ instance ToJSON RepoWebhookEvent where 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 WebhookForkApplyEvent = String "fork_apply" - toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" toJSON WebhookGistEvent = String "gist" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" toJSON WebhookGollumEvent = String "gollum" toJSON WebhookInstallationEvent = String "installation" toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" @@ -214,8 +232,9 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookMembershipEvent = String "membership" toJSON WebhookMetaEvent = String "meta" toJSON WebhookMilestoneEvent = String "milestone" - toJSON WebhookOrganizationEvent = String "organization" 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" @@ -223,20 +242,25 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookProjectEvent = String "project" toJSON WebhookPublicEvent = String "public" toJSON WebhookPullRequestEvent = String "pull_request" - toJSON WebhookPullRequestReviewEvent = String "pull_request_review" toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON 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 WebhookTeamEvent = String "team" 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 From 2d3bd03f72e5640ff9a7708d3ef35890dbdce998 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Oct 2021 00:27:27 +0300 Subject: [PATCH 233/309] Regenerate CI --- .github/workflows/haskell-ci.yml | 101 ++++++++++++++++++++----------- 1 file changed, 67 insertions(+), 34 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 637021b1..f70f1749 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.11.20210222 +# version: 0.13.20210827 # -# REGENDATA ("0.11.20210222",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.13.20210827",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -22,7 +22,7 @@ on: - master jobs: linux: - name: Haskell-CI - Linux - GHC ${{ matrix.ghc }} + name: Haskell-CI - Linux - ${{ matrix.compiler }} runs-on: ubuntu-18.04 container: image: buildpack-deps:bionic @@ -30,55 +30,87 @@ jobs: strategy: matrix: include: - - ghc: 9.0.1 + - compiler: ghc-9.0.1 + compilerKind: ghc + compilerVersion: 9.0.1 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.10.4 + - compiler: ghc-8.10.4 + compilerKind: ghc + compilerVersion: 8.10.4 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.8.4 + - compiler: ghc-8.8.4 + compilerKind: ghc + compilerVersion: 8.8.4 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.6.5 + - compiler: ghc-8.6.5 + compilerKind: ghc + compilerVersion: 8.6.5 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.4.4 + - compiler: ghc-8.4.4 + compilerKind: ghc + compilerVersion: 8.4.4 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.2.2 + - compiler: ghc-8.2.2 + compilerKind: ghc + compilerVersion: 8.2.2 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.0.2 + - compiler: ghc-8.0.2 + compilerKind: ghc + compilerVersion: 8.0.2 + setup-method: hvr-ppa allow-failure: false - - ghc: 7.10.3 + - compiler: ghc-7.10.3 + compilerKind: ghc + compilerVersion: 7.10.3 + setup-method: hvr-ppa allow-failure: false - - ghc: 7.8.4 + - compiler: ghc-7.8.4 + compilerKind: ghc + compilerVersion: 7.8.4 + setup-method: hvr-ppa allow-failure: false fail-fast: false steps: - name: apt run: | apt-get update - apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 apt-add-repository -y 'ppa:hvr/ghc' apt-get update - apt-get install -y ghc-$GHC_VERSION cabal-install-3.4 + apt-get install -y "$HCNAME" cabal-install-3.4 env: - GHC_VERSION: ${{ matrix.ghc }} + 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 - HC=/opt/ghc/$GHC_VERSION/bin/ghc - echo "HC=$HC" >> $GITHUB_ENV - echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV - echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV - echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV + echo "LANG=C.UTF-8" >> "$GITHUB_ENV" + echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" + echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" + HCDIR=/opt/$HCKIND/$HCVER + HC=$HCDIR/bin/$HCKIND + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" + echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" + echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> "$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 - echo "HEADHACKAGE=false" >> $GITHUB_ENV - echo "ARG_COMPILER=--ghc --with-compiler=$HC" >> $GITHUB_ENV - echo "GHCJSARITH=0" >> $GITHUB_ENV + echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" + echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" + echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" + echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: - GHC_VERSION: ${{ matrix.ghc }} + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} - name: env run: | env @@ -140,9 +172,10 @@ jobs: - 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 + 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 + 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 @@ -171,9 +204,9 @@ jobs: - name: cache uses: actions/cache@v2 with: - key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store - restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- + restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- - name: install dependencies run: | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all From a9656e92a8312e08df9a5f0000e6d1c8bd32d4fa Mon Sep 17 00:00:00 2001 From: sanjiv sahayam Date: Mon, 3 Aug 2020 09:28:54 +1000 Subject: [PATCH 234/309] Fix decoding of optional submitted_at field in review --- fixtures/pull-request-approved-review.json | 38 ++++++++++++++++++++++ fixtures/pull-request-pending-review.json | 37 +++++++++++++++++++++ github.cabal | 1 + spec/GitHub/ReviewDecodeSpec.hs | 25 ++++++++++++++ src/GitHub/Data/Reviews.hs | 12 +++---- 5 files changed, 107 insertions(+), 6 deletions(-) create mode 100644 fixtures/pull-request-approved-review.json create mode 100644 fixtures/pull-request-pending-review.json create mode 100644 spec/GitHub/ReviewDecodeSpec.hs 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-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/github.cabal b/github.cabal index 3d2cd03b..8b24a863 100644 --- a/github.cabal +++ b/github.cabal @@ -223,6 +223,7 @@ test-suite github-test GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec + GitHub.ReviewDecodeSpec GitHub.SearchSpec GitHub.UsersSpec 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/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 27278437..72c6f6be 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -35,7 +35,7 @@ data Review = Review { reviewBody :: !Text , reviewCommitId :: !Text , reviewState :: ReviewState - , reviewSubmittedAt :: !UTCTime + , reviewSubmittedAt :: !(Maybe UTCTime) , reviewPullRequestUrl :: !URL , reviewHtmlUrl :: !Text , reviewUser :: !SimpleUser @@ -51,11 +51,11 @@ instance FromJSON Review where parseJSON = withObject "Review" $ \o -> Review <$> o .: "body" <*> o .: "commit_id" <*> o .: "state" <*> - o .: "submitted_at" <*> - o .: "pull_request_url" <*> - o .: "html_url" <*> - o .: "user" <*> - o .: "id" + o .:? "submitted_at" <*> + o .: "pull_request_url" <*> + o .: "html_url" <*> + o .: "user" <*> + o .: "id" data ReviewComment = ReviewComment { reviewCommentId :: !(Id ReviewComment) From dd3dfbccaf4de4c3095b52fefb52c6b3c961a8f8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Oct 2021 00:28:23 +0300 Subject: [PATCH 235/309] Support aeson-2.0, and more bound relaxations --- .github/workflows/haskell-ci.yml | 1 + cabal.project | 1 + github.cabal | 6 +++--- src/GitHub/Data/Content.hs | 9 +++++++++ src/GitHub/Internal/Prelude.hs | 1 + 5 files changed, 15 insertions(+), 3 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index f70f1749..7bddbf8e 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -192,6 +192,7 @@ jobs: allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim allow-newer: cryptohash-sha1-0.11.100.1:base + allow-newer: http-link-header-1.2.0:attoparsec optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local diff --git a/cabal.project b/cabal.project index 5e40418a..0f0cd647 100644 --- a/cabal.project +++ b/cabal.project @@ -13,3 +13,4 @@ constraints: github-samples +openssl allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim allow-newer: cryptohash-sha1-0.11.100.1:base +allow-newer: http-link-header-1.2.0:attoparsec diff --git a/github.cabal b/github.cabal index 3d2cd03b..bf5dd3ba 100644 --- a/github.cabal +++ b/github.cabal @@ -170,8 +170,8 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.6 - , base-compat >=0.11.1 && <0.12 + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.1 + , base-compat >=0.11.1 && <0.13 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 @@ -184,7 +184,7 @@ library , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , tagged >=0.8.5 && <0.9 - , transformers-compat >=0.6.5 && <0.7 + , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 5461ffa0..5580c866 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -15,6 +16,10 @@ import Data.Aeson.Types (Pair) import Data.Maybe (maybe) 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) @@ -205,5 +210,9 @@ instance ToJSON DeleteFile where ++ "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/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 8c4785c3..2ac8633c 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause From 25682961a30c6c18869cf00c24c2a44f232d0873 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Oct 2021 17:54:20 +0300 Subject: [PATCH 236/309] Prepare 0.27 --- CHANGELOG.md | 11 +++++++++++ github.cabal | 2 +- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 991d24c7..eddba7a7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +## Changes for 0.27 + +- Add vector of SimpleTeam in "requested_teams" field of PullRequest + [#453](https://github.com/phadej/github/pull/453) +- Add endpoint to create gist + [#455](https://github.com/phadej/github/pull/455) +- Update RepoWebhookEvent + [#461](https://github.com/phadej/github/pull/461) +- PullRequest Reviews may not have submitted_at field + [#450](https://github.com/phadej/github/pull/450) + ## Changes for 0.26 - Generalize PagedQuery to allow its reuse by preview github APIs diff --git a/github.cabal b/github.cabal index e3edf30a..c25f94f3 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.26 +version: 0.27 synopsis: Access to the GitHub API, v3. category: Network description: From 9df0ad57644a8af9de15e222da233e5e2eba8c61 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 13 Nov 2021 20:25:31 +0200 Subject: [PATCH 237/309] Allow base-4.16, hashable-1.4, bytestring-0.11 --- .github/workflows/haskell-ci.yml | 63 ++++++++++++++++++++++++-------- cabal.project | 5 +-- github.cabal | 14 ++++--- samples/github-samples.cabal | 3 +- 4 files changed, 59 insertions(+), 26 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 7bddbf8e..463233e7 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.13.20210827 +# version: 0.13.20211111 # -# REGENDATA ("0.13.20210827",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.13.20211111",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -24,21 +24,28 @@ jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} runs-on: ubuntu-18.04 + timeout-minutes: + 60 container: image: buildpack-deps:bionic continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: + - compiler: ghc-9.2.1 + compilerKind: ghc + compilerVersion: 9.2.1 + setup-method: ghcup + allow-failure: false - compiler: ghc-9.0.1 compilerKind: ghc compilerVersion: 9.0.1 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-8.10.4 + - compiler: ghc-8.10.7 compilerKind: ghc - compilerVersion: 8.10.4 - setup-method: hvr-ppa + compilerVersion: 8.10.7 + setup-method: ghcup allow-failure: false - compiler: ghc-8.8.4 compilerKind: ghc @@ -81,9 +88,21 @@ jobs: run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 - apt-add-repository -y 'ppa:hvr/ghc' - apt-get update - apt-get install -y "$HCNAME" cabal-install-3.4 + if [ "${{ matrix.setup-method }}" = ghcup ]; then + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + else + apt-add-repository -y 'ppa:hvr/ghc' + apt-get update + apt-get install -y "$HCNAME" + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + fi env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -95,11 +114,20 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - HC=$HCDIR/bin/$HCKIND - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" - echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> "$GITHUB_ENV" + if [ "${{ matrix.setup-method }}" = ghcup ]; then + HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" + echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + else + HC=$HCDIR/bin/$HCKIND + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" + echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + fi + 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" @@ -133,6 +161,10 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + cat >> $CABAL_CONFIG <= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <=1.3 + constraints: hashable >=1.3 constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim - allow-newer: cryptohash-sha1-0.11.100.1:base - allow-newer: http-link-header-1.2.0:attoparsec + allow-newer: HsOpenSSL:bytestring optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local diff --git a/cabal.project b/cabal.project index 0f0cd647..b9ac7eb6 100644 --- a/cabal.project +++ b/cabal.project @@ -4,7 +4,7 @@ packages: samples optimization: False tests: True -constraints: hashable ^>=1.3 +constraints: hashable >=1.3 constraints: semigroups ^>=0.19 constraints: github +openssl @@ -12,5 +12,4 @@ constraints: github-samples +openssl allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim -allow-newer: cryptohash-sha1-0.11.100.1:base -allow-newer: http-link-header-1.2.0:attoparsec +allow-newer: HsOpenSSL:bytestring diff --git a/github.cabal b/github.cabal index c25f94f3..e9f0b5bf 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,7 @@ cabal-version: >=1.10 name: github version: 0.27 +x-revision: 1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -37,8 +38,9 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.4 - || ==8.10.4 + || ==8.10.7 || ==9.0.1 + || ==9.2.1 extra-source-files: README.md @@ -158,9 +160,9 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.16 + base >=4.7 && <4.17 , binary >=0.7.1.0 && <0.11 - , bytestring >=0.10.4.0 && <0.11 + , bytestring >=0.10.4.0 && <0.12 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 @@ -177,7 +179,7 @@ library , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 - , hashable >=1.2.7.0 && <1.4 + , hashable >=1.2.7.0 && <1.5 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 , http-types >=0.12.3 && <0.13 @@ -209,7 +211,7 @@ test-suite github-test hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded - build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.8 + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.10 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec @@ -234,7 +236,7 @@ test-suite github-test , bytestring , file-embed , github - , hspec >=2.6.1 && <2.8 + , hspec >=2.6.1 && <2.10 , tagged , text , unordered-containers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 270609d7..f1ff2045 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -16,8 +16,9 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.4 - || ==8.10.4 + || ==8.10.7 || ==9.0.1 + || ==9.2.1 library hs-source-dirs: src From 558ab0d73d93837c0c53c75df4a1cc439884ff54 Mon Sep 17 00:00:00 2001 From: snxx-lppxx Date: Sat, 18 Dec 2021 19:54:02 +0500 Subject: [PATCH 238/309] readme: fix company name --- README.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index d6996412..f808c2a8 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,13 @@ -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] -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 From 4184b466b968ad25d7e1e38c08ec9315ed1ce145 Mon Sep 17 00:00:00 2001 From: snxx-lppxx Date: Sat, 18 Dec 2021 21:13:01 +0500 Subject: [PATCH 239/309] addition #471 --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index f808c2a8..0a27ff91 100644 --- a/README.md +++ b/README.md @@ -40,7 +40,7 @@ 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](http://developer.github.com/v3/). 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` From ec59ef8c683a8f2fa5a91efaf78ff8154420716c Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 8 Dec 2021 22:36:18 +0100 Subject: [PATCH 240/309] Silence compilation warnings for github library - remove unused imports - disable star-is-type warning while we are supporting GHC 7 --- github.cabal | 8 +++++++- src/GitHub/Data/Content.hs | 1 - src/GitHub/Data/Deployments.hs | 3 --- src/GitHub/Data/Reviews.hs | 1 - src/GitHub/Endpoints/PullRequests/Reviews.hs | 1 - src/GitHub/Endpoints/Repos/Deployments.hs | 2 -- src/GitHub/Request.hs | 3 +-- 7 files changed, 8 insertions(+), 11 deletions(-) diff --git a/github.cabal b/github.cabal index e9f0b5bf..c2da752b 100644 --- a/github.cabal +++ b/github.cabal @@ -58,7 +58,13 @@ flag openssl library default-language: Haskell2010 - ghc-options: -Wall + ghc-options: + -Wall + if impl(ghc >= 8.0) + ghc-options: + -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 diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 5580c866..7a4dca9b 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -13,7 +13,6 @@ import GitHub.Internal.Prelude import Prelude () import Data.Aeson.Types (Pair) -import Data.Maybe (maybe) import qualified Data.Text as T #if MIN_VERSION_aeson(2,0,0) diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index face7a52..e14a214e 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -19,9 +19,6 @@ import Prelude () import Control.Arrow (second) import Data.ByteString (ByteString) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Data.Vector (Vector) import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 72c6f6be..b00edb74 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -6,7 +6,6 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -import Data.Text (Text) import qualified Data.Text as T data ReviewState diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index e5c42ac8..fe95d25b 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -12,7 +12,6 @@ module GitHub.Endpoints.PullRequests.Reviews ) where import GitHub.Data -import GitHub.Data.Id (Id) import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs index ed94c16a..39724771 100644 --- a/src/GitHub/Endpoints/Repos/Deployments.hs +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -11,8 +11,6 @@ module GitHub.Endpoints.Repos.Deployments import Control.Arrow (second) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Internal.Prelude diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 808f33a7..2481deea 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -80,8 +80,7 @@ import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) -import Data.List (find, intercalate) -import Data.String (fromString) +import Data.List (find) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) From abc27cab9af8769eed34242d1f0a2718d05d15b1 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 8 Dec 2021 22:54:49 +0100 Subject: [PATCH 241/309] Complete API for repo-issues Add missing methods to set the following fields of 'IssueRepoOptions': - specific milestone - specific assignee - creator - mentioned --- github.cabal | 3 +- src/GitHub/Data/Options.hs | 107 ++++++++++++++++++++++++++++++++----- 2 files changed, 96 insertions(+), 14 deletions(-) diff --git a/github.cabal b/github.cabal index c2da752b..2d90197f 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.27 -x-revision: 1 +version: 0.28 synopsis: Access to the GitHub API, v3. category: Network description: diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 70665317..c861c212 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -38,12 +38,16 @@ module GitHub.Data.Options ( -- * Repo issues IssueRepoMod, issueRepoModToQueryString, + optionsCreator, + optionsMentioned, optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, + optionsMilestone, optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, + optionsAssignee, -- * Data IssueState (..), MergeableState (..), @@ -351,7 +355,7 @@ sortByLongRunning = PRMod $ \opts -> -- Issues ------------------------------------------------------------------------------- --- | See . +-- | See . data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) @@ -373,7 +377,7 @@ defaultIssueOptions = IssueOptions , issueOptionsSince = Nothing } --- | See . +-- | See . newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) instance Semigroup IssueMod where @@ -491,16 +495,70 @@ issueFilter f = IssueMod $ \opts -> -- Issues repo ------------------------------------------------------------------------------- +-- | See . +-- Retrieved: 2021-12-08 +-- +-- Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@) +-- +-- * milestone : string +-- +-- If an integer is passed, it should refer to a milestone by its number field. If the string * is passed, issues with any milestone are accepted. If the string none is passed, issues without milestones are returned. +-- +-- * state : string +-- +-- Indicates the state of the issues to return. Can be either open, closed, or all. +-- Default: open +-- +-- * assignee : string +-- +-- Can be the name of a user. Pass in none for issues with no assigned user, and * for issues assigned to any user. +-- +-- * creator : string +-- +-- The user that created the issue. +-- +-- * mentioned : string +-- +-- A user that's mentioned in the issue. +-- +-- * labels : string +-- +-- A list of comma separated label names. Example: bug,ui,@high +-- +-- * sort : string +-- +-- What to sort results by. Can be either created, updated, comments. +-- Default: created +-- +-- * direction : string +-- +-- One of asc (ascending) or desc (descending). +-- Default: desc +-- +-- * since : string +-- +-- Only show notifications updated after the given time. This is a timestamp in ISO 8601 format: YYYY-MM-DDTHH:MM:SSZ. +-- +-- * per_page : integer +-- +-- Results per page (max 100) +-- Default: 30 +-- +-- * page : integer +-- +-- Page number of the results to fetch. +-- Default: 1 +-- data IssueRepoOptions = IssueRepoOptions - { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) - , issueRepoOptionsState :: !(Maybe IssueState) - , issueRepoOptionsAssignee :: !(FilterBy (Name User)) - , issueRepoOptionsCreator :: !(Maybe (Name User)) - , issueRepoOptionsMentioned :: !(Maybe (Name User)) - , issueRepoOptionsLabels :: ![Name IssueLabel] - , issueRepoOptionsSort :: !SortIssue - , issueRepoOptionsDirection :: !SortDirection - , issueRepoOptionsSince :: !(Maybe UTCTime) + { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) -- ^ 'optionsMilestone' etc. + , issueRepoOptionsState :: !(Maybe IssueState) -- ^ 'HasState' + , issueRepoOptionsAssignee :: !(FilterBy (Name User)) -- ^ 'optionsAssignee' etc. + , issueRepoOptionsCreator :: !(Maybe (Name User)) -- ^ 'optionsCreator' + , issueRepoOptionsMentioned :: !(Maybe (Name User)) -- ^ 'optionsMentioned' + , issueRepoOptionsLabels :: ![Name IssueLabel] -- ^ 'HasLabels' + , issueRepoOptionsSort :: !SortIssue -- ^ 'HasCreatedUpdated' and 'HasComments' + , issueRepoOptionsDirection :: !SortDirection -- ^ 'HasDirection' + , issueRepoOptionsSince :: !(Maybe UTCTime) -- ^ 'HasSince' } deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -579,7 +637,17 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = -- Issues repo modifiers ------------------------------------------------------------------------------- --- | Don't care about milestones. +-- | Issues created by a certain user. +optionsCreator :: Name User -> IssueRepoMod +optionsCreator u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsCreator = Just u } + +-- | Issue mentioning the given user. +optionsMentioned :: Name User -> IssueRepoMod +optionsMentioned u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMentioned = Just u } + +-- | Don't care about milestones (default). -- -- 'optionsAnyMilestone' means there should be some milestone, but it can be any. -- @@ -588,22 +656,37 @@ 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 } From 3a26d2f17d345c0cd706b8fbe869d6fdd0528af5 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 21 Dec 2021 15:12:18 +0100 Subject: [PATCH 242/309] PR #470: no major version bump, remove clone of GitHub API docs --- github.cabal | 2 +- src/GitHub/Data/Options.hs | 54 ++------------------------------------ 2 files changed, 3 insertions(+), 53 deletions(-) diff --git a/github.cabal b/github.cabal index 2d90197f..be54e398 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.28 +version: 0.27.1 synopsis: Access to the GitHub API, v3. category: Network description: diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index c861c212..24bc4369 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -495,59 +495,9 @@ issueFilter f = IssueMod $ \opts -> -- Issues repo ------------------------------------------------------------------------------- --- | See . --- Retrieved: 2021-12-08 +-- | Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@). -- --- Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@) --- --- * milestone : string --- --- If an integer is passed, it should refer to a milestone by its number field. If the string * is passed, issues with any milestone are accepted. If the string none is passed, issues without milestones are returned. --- --- * state : string --- --- Indicates the state of the issues to return. Can be either open, closed, or all. --- Default: open --- --- * assignee : string --- --- Can be the name of a user. Pass in none for issues with no assigned user, and * for issues assigned to any user. --- --- * creator : string --- --- The user that created the issue. --- --- * mentioned : string --- --- A user that's mentioned in the issue. --- --- * labels : string --- --- A list of comma separated label names. Example: bug,ui,@high --- --- * sort : string --- --- What to sort results by. Can be either created, updated, comments. --- Default: created --- --- * direction : string --- --- One of asc (ascending) or desc (descending). --- Default: desc --- --- * since : string --- --- Only show notifications updated after the given time. This is a timestamp in ISO 8601 format: YYYY-MM-DDTHH:MM:SSZ. --- --- * per_page : integer --- --- Results per page (max 100) --- Default: 30 --- --- * page : integer --- --- Page number of the results to fetch. --- Default: 1 +-- See . -- data IssueRepoOptions = IssueRepoOptions { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) -- ^ 'optionsMilestone' etc. From 16d5350a57a5b9917dac7ee42f00c3473bf8e75e Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Sat, 2 Apr 2022 13:19:37 +0200 Subject: [PATCH 243/309] Repo: add permissions field (#476) Adds field `repoPermissions` to `Repo` record. --- src/GitHub/Data/Repos.hs | 21 +++++++++++++++++++++ src/GitHub/Endpoints/Repos.hs | 6 +++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index d9c9cf1b..0019b173 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -61,12 +61,26 @@ data Repo = Repo , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories , repoCreatedAt :: !(Maybe UTCTime) , repoUpdatedAt :: !(Maybe UTCTime) + , repoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance Binary Repo +-- | 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, Typeable, Eq, Ord, Generic) + +instance NFData RepoPermissions where rnf = genericRnf +instance Binary RepoPermissions + data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) @@ -214,6 +228,7 @@ instance FromJSON Repo where <*> o .:? "pushed_at" <*> o .:? "created_at" <*> o .:? "updated_at" + <*> o .:? "permissions" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name @@ -273,6 +288,12 @@ instance ToJSON EditRepo where , "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" diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 38fe1e6f..b8c9d79d 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -43,7 +43,7 @@ repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. --- See +-- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = pagedQuery ["user", "repos"] qs @@ -51,7 +51,7 @@ currentUserReposR publicity = qs = repoPublicityQueryString publicity -- | List user repositories. --- See +-- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = pagedQuery ["users", toPathPart user, "repos"] qs @@ -59,7 +59,7 @@ userReposR user publicity = qs = repoPublicityQueryString publicity -- | List organization repositories. --- See +-- See organizationReposR :: Name Organization -> RepoPublicity From e619f76caf672cc78b676f56755e362dc1c838b8 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 4 Apr 2022 06:13:22 +0800 Subject: [PATCH 244/309] Replace Travis CI with GitHub Actions in README (#475) --- README.md | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/README.md b/README.md index 0a27ff91..18313f24 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ GitHub ------ -[![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/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) [![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] The GitHub API v3 for Haskell. @@ -30,7 +30,7 @@ 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. @@ -51,7 +51,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 #-} @@ -77,21 +77,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 From 86ab6944b26b346ca4d4490a30b241cd8c42b19a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 14:18:10 +0200 Subject: [PATCH 245/309] Close #355: comment that haddocks only build from GHC 8.6 --- cabal.haskell-ci | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal.haskell-ci b/cabal.haskell-ci index bcb8a5d9..ddf7ff7b 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,2 +1,3 @@ branches: master haddock: >=8.6 + -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 From 4c922eb3edf82473cc78dc9b85911cbd8d4610e5 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 17:16:42 +0200 Subject: [PATCH 246/309] Update `CreateIssue.hs` to new request model and OAuth (#477) * Fix compiler errors * If there are no labels, than the output should be an empty array. * Move formatUser to own function * Remove empty line * Update CreateIssue.hs to request model & OAuth; add cabal entry (#195) Can be run as follows: samples/$ GITHUB_TOKEN=<> cabal run github-create-issue * Drop testing with GHC-7.8.4 Drop building `samples` with GHC-7.8 because `System.Exit.die` is only available from GHC 7.10. * Restore testing with GHC-7.8.4 except for samples Co-authored-by: Amitaibu --- .github/workflows/haskell-ci.yml | 26 ++++++------- cabal.haskell-ci | 1 + github.cabal | 4 +- samples/Issues/CreateIssue.hs | 67 +++++++++++++++++++++++--------- samples/github-samples.cabal | 18 ++++++--- 5 files changed, 77 insertions(+), 39 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 463233e7..bbd13145 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.13.20211111 +# version: 0.14.3.20220416 # -# REGENDATA ("0.13.20211111",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.14.3.20220416",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,15 +32,15 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.2.1 + - compiler: ghc-9.2.2 compilerKind: ghc - compilerVersion: 9.2.1 + compilerVersion: 9.2.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.0.1 + - compiler: ghc-9.0.2 compilerKind: ghc - compilerVersion: 9.0.1 - setup-method: hvr-ppa + compilerVersion: 9.0.2 + setup-method: ghcup allow-failure: false - compiler: ghc-8.10.7 compilerKind: ghc @@ -90,7 +90,7 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 @@ -99,7 +99,7 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 fi @@ -191,7 +191,7 @@ jobs: run: | touch cabal.project echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project - echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -211,7 +211,7 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - echo "packages: ${PKGDIR_github_samples}" >> cabal.project + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi @@ -256,8 +256,8 @@ jobs: run: | cd ${PKGDIR_github} || false ${CABAL} -vnormal check - cd ${PKGDIR_github_samples} || false - ${CABAL} -vnormal check + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi diff --git a/cabal.haskell-ci b/cabal.haskell-ci index ddf7ff7b..eb8a2be2 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,3 +1,4 @@ branches: master haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 +jobs-selection: any diff --git a/github.cabal b/github.cabal index be54e398..04cb2c9a 100644 --- a/github.cabal +++ b/github.cabal @@ -38,8 +38,8 @@ tested-with: || ==8.6.5 || ==8.8.4 || ==8.10.7 - || ==9.0.1 - || ==9.2.1 + || ==9.0.2 + || ==9.2.2 extra-source-files: README.md 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/github-samples.cabal b/samples/github-samples.cabal index f1ff2045..d71cd143 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -9,16 +9,15 @@ maintainer: Oleg Grenrus description: Various samples of github package build-type: Simple tested-with: - GHC ==7.8.4 - || ==7.10.3 + GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 - || ==9.0.1 - || ==9.2.1 + || ==9.0.2 + || ==9.2.2 library hs-source-dirs: src @@ -50,9 +49,11 @@ executable github-operational common deps default-language: Haskell2010 - ghc-options: -Wall + ghc-options: + -Wall + -threaded build-depends: - , base >=4.7 && <5 + , base >=4.8 && <5 , base-compat-batteries , base64-bytestring , github @@ -70,6 +71,11 @@ executable github-create-deploy-key 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 From 59967287df3128fa93a9a6edc95d1b3911e1e1ec Mon Sep 17 00:00:00 2001 From: Owen Shepherd <414owen@gmail.com> Date: Fri, 29 Apr 2022 13:32:32 +0100 Subject: [PATCH 247/309] Add unwatch request (#473) - Add unsubscribe request - Add unwatch request sample - Add Unwatch sample to github-samples.cabal --- samples/Repos/Watching/Unwatch.hs | 17 +++++++++++++++++ samples/github-samples.cabal | 6 ++++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Activity/Watching.hs | 7 +++++++ 4 files changed, 31 insertions(+), 1 deletion(-) create mode 100644 samples/Repos/Watching/Unwatch.hs 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/github-samples.cabal b/samples/github-samples.cabal index d71cd143..1182fdf4 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -166,6 +166,12 @@ executable github-teaminfo-for 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 diff --git a/src/GitHub.hs b/src/GitHub.hs index e00a53cb..da5e9f2b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -52,9 +52,9 @@ module GitHub ( -- -- * Query a Repository Subscription -- * Set a Repository Subscription - -- * Delete a Repository Subscription watchersForR, reposWatchedByR, + unwatchRepoR, -- * Gists -- | See diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index cd58b44f..92b7829d 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -8,6 +8,7 @@ module GitHub.Endpoints.Activity.Watching ( watchersForR, reposWatchedByR, + unwatchRepoR, module GitHub.Data, ) where @@ -27,3 +28,9 @@ watchersForR user repo limit = reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = pagedQuery ["users", toPathPart user, "subscriptions"] [] + +-- | Stop watching repository. +-- See +unwatchRepoR :: Name Owner -> Name Repo -> Request 'RW () +unwatchRepoR owner repo = + command Delete ["repos", toPathPart owner, toPathPart repo, "subscription"] mempty From 83acdf8f4c7d525c896e9d12494be65a628007c3 Mon Sep 17 00:00:00 2001 From: Owen Shepherd Date: Fri, 29 Apr 2022 20:49:41 +0100 Subject: [PATCH 248/309] Make searches paginated (#474) Previously, searches only returned the first thirty results, and there was no way to access page two. Note that this is a breaking API change. - Add paginated searches - Update SearchCode sample to use pagination - Update SearchIssues sample to use pagination - Update SearchRepos sample to use pagination --- samples/Search/SearchCode.hs | 39 ++++++++++---------- samples/Search/SearchIssues.hs | 37 ++++++++++--------- samples/Search/SearchRepos.hs | 57 +++++++++++++++-------------- samples/github-samples.cabal | 19 ++++++++++ spec/GitHub/SearchSpec.hs | 6 ++-- src/GitHub/Data/Repos.hs | 65 ++++++++++++++++++++++++++++++++++ src/GitHub/Data/Search.hs | 24 ++++++++----- src/GitHub/Endpoints/Search.hs | 16 ++++----- 8 files changed, 180 insertions(+), 83 deletions(-) diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs index 68a73c96..c632e2ae 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) - 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..0a558b7e 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -1,50 +1,52 @@ {-# 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 @@ -52,5 +54,6 @@ formatRepo r = fill n s = s ++ replicate n' ' ' 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/github-samples.cabal b/samples/github-samples.cabal index 1182fdf4..43b5ac3c 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -156,6 +156,25 @@ executable github-show-user-2 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 diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 5cc5a15f..f82a2051 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -18,7 +18,7 @@ import GitHub (github) import GitHub.Data (Auth (..), Issue (..), IssueNumber (..), IssueState (..), SimpleUser (..), User, mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR, searchUsersR) +import GitHub.Endpoints.Search (SearchResult' (..), SearchResult, searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -55,13 +55,13 @@ spec = do 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 <$> github auth searchIssuesR query + 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 <- searchResultResults . fromRightS <$> github auth searchUsersR query + 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/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 0019b173..63779d77 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -68,6 +68,41 @@ data Repo = Repo instance NFData Repo where rnf = genericRnf 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, Typeable, Eq, Ord, Generic) + +instance NFData CodeSearchRepo where rnf = genericRnf +instance Binary CodeSearchRepo + -- | Repository permissions, as they relate to the authenticated user. -- -- Returned by for example 'GitHub.Endpoints.Repos.currentUserReposR' @@ -230,6 +265,36 @@ instance FromJSON Repo where <*> 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 diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index cfef5ca1..951d1c83 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -5,26 +5,34 @@ -- module GitHub.Data.Search where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (CodeSearchRepo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V -data SearchResult entity = SearchResult +data SearchResult' entities = SearchResult { searchResultTotalCount :: !Int - , searchResultResults :: !(Vector entity) + , searchResultResults :: !entities } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf -instance Binary entity => Binary (SearchResult entity) +type SearchResult entity = SearchResult' (V.Vector entity) -instance FromJSON entity => FromJSON (SearchResult entity) where +instance NFData entities => NFData (SearchResult' entities) where rnf = genericRnf +instance Binary entities => Binary (SearchResult' entities) + +instance (Monoid entities, FromJSON entities) => FromJSON (SearchResult' entities) where parseJSON = withObject "SearchResult" $ \o -> SearchResult <$> o .: "total_count" - <*> o .:? "items" .!= V.empty + <*> o .:? "items" .!= mempty + +instance Semigroup res => Semigroup (SearchResult' res) where + (SearchResult count res) <> (SearchResult count' res') = SearchResult (max count count') (res <> res') + +instance Foldable SearchResult' where + foldMap f (SearchResult count results) = f results data Code = Code { codeName :: !Text @@ -33,7 +41,7 @@ data Code = Code , codeUrl :: !URL , codeGitUrl :: !URL , codeHtmlUrl :: !URL - , codeRepo :: !Repo + , codeRepo :: !CodeSearchRepo } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 3fb50e85..36b8c414 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -21,24 +21,24 @@ import qualified Data.Text.Encoding as TE -- | Search repositories. -- See -searchReposR :: Text -> Request k (SearchResult Repo) +searchReposR :: Text -> FetchCount -> Request k (SearchResult Repo) searchReposR searchString = - query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search code. -- See -searchCodeR :: Text -> Request k (SearchResult Code) +searchCodeR :: Text -> FetchCount -> Request k (SearchResult Code) searchCodeR searchString = - query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search issues. -- See -searchIssuesR :: Text -> Request k (SearchResult Issue) +searchIssuesR :: Text -> FetchCount -> Request k (SearchResult Issue) searchIssuesR searchString = - query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search users. -- See -searchUsersR :: Text -> Request k (SearchResult SimpleUser) +searchUsersR :: Text -> FetchCount -> Request k (SearchResult SimpleUser) searchUsersR searchString = - query ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] From d07a9f992b3c7afb1429683198cb3045e530dc2b Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 17:58:38 +0200 Subject: [PATCH 249/309] Fix whitespace in {*hs, *.md} files --- CHANGELOG.md | 6 +++--- samples/GitData/References/GitCreateReference.hs | 2 +- samples/Issues/IssueReport/Issues.hs | 8 ++++---- samples/Issues/IssueReport/IssuesEnterprise.hs | 8 ++++---- samples/Issues/IssueReport/Report.hs | 2 +- samples/Repos/Commits/GitShow.hs | 2 +- samples/Repos/DeployKeys/ShowDeployKey.hs | 1 - samples/Search/SearchCode.hs | 2 +- samples/Search/SearchRepos.hs | 2 +- samples/Users/Followers/ListFollowers.hs | 2 +- samples/Users/Followers/ListFollowing.hs | 2 +- spec/GitHub/ActivitySpec.hs | 2 +- spec/GitHub/EventsSpec.hs | 2 +- src/GitHub/Data/Events.hs | 4 ++-- 14 files changed, 22 insertions(+), 23 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index eddba7a7..10cc9b18 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,7 +6,7 @@ [#455](https://github.com/phadej/github/pull/455) - Update RepoWebhookEvent [#461](https://github.com/phadej/github/pull/461) -- PullRequest Reviews may not have submitted_at field +- PullRequest Reviews may not have submitted_at field [#450](https://github.com/phadej/github/pull/450) ## Changes for 0.26 @@ -23,7 +23,7 @@ [#417](https://github.com/phadej/github/pull/417) - Add deleteReference endpoint [#388](https://github.com/phadej/github/pull/388) - + ## Changes for 0.25 - Add `executeRequestWithMgrAndRes` @@ -145,7 +145,7 @@ This reduces symbol bloat in the library. [#307](https://github.com/phadej/github/pull/307) - Make "repo" in PullRequestCommit nullable (repository can be gone) [#311](https://github.com/phadej/github/pull/311) -- Add read-only emails endpoint +- Add read-only emails endpoint [#313](https://github.com/phadej/github/pull/313) - Organisation membership API [#312](https://github.com/phadej/github/pull/312) 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/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/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/DeployKeys/ShowDeployKey.hs b/samples/Repos/DeployKeys/ShowDeployKey.hs index 48e06b94..6df4d11c 100644 --- a/samples/Repos/DeployKeys/ShowDeployKey.hs +++ b/samples/Repos/DeployKeys/ShowDeployKey.hs @@ -17,4 +17,3 @@ main = do formatRepoDeployKey :: DK.RepoDeployKey -> String formatRepoDeployKey = show - diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs index c632e2ae..f5b472cb 100644 --- a/samples/Search/SearchCode.hs +++ b/samples/Search/SearchCode.hs @@ -30,4 +30,4 @@ formatCode r = 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/SearchRepos.hs b/samples/Search/SearchRepos.hs index 0a558b7e..e09c2bfc 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -52,7 +52,7 @@ formatRepo r = 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 UTCTime -> String diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index a5ef346c..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" GitHub.FetchAll + 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 171f2fba..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" GitHub.FetchAll + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 1f3c82c3..73b044a0 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -30,7 +30,7 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll + cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs index 93f613b1..ae51a1a2 100644 --- a/spec/GitHub/EventsSpec.hs +++ b/spec/GitHub/EventsSpec.hs @@ -29,7 +29,7 @@ spec = do it "returns non empty list of events" $ shouldSucceed $ GitHub.repositoryEventsR "phadej" "github" 1 describe "userEventsR" $ do - it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 + it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 where shouldSucceed f = withAuth $ \auth -> do cs <- GitHub.executeRequest auth $ f cs `shouldSatisfy` isRight diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index 8ec6a22d..d7b34528 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -23,10 +23,10 @@ data Event = Event deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf -instance Binary Event +instance Binary Event instance FromJSON Event where - parseJSON = withObject "Event" $ \obj -> Event + parseJSON = withObject "Event" $ \obj -> Event -- <$> obj .: "id" <$> obj .: "actor" <*> obj .: "created_at" From 9d0f1bee5fe58f7d349bc23ec29d19f6cde0930d Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 18:07:31 +0200 Subject: [PATCH 250/309] fix-whitespace configuration file Fix whitespace violations in files as defined by fix-whitespace.yaml via $ fix-whitespace --- fix-whitespace.yaml | 61 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 fix-whitespace.yaml 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: From 90a70c3722dfdd4f916d3ab3616f292953a8f664 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 18:28:19 +0200 Subject: [PATCH 251/309] CHANGELOG & .cabal: move phadej -> haskell-github Also: cosmetical fixes --- CHANGELOG.md | 208 +++++++++++++++++++++++++-------------------------- github.cabal | 6 +- 2 files changed, 107 insertions(+), 107 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 10cc9b18..b7bcbc47 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,49 +1,49 @@ ## Changes for 0.27 -- Add vector of SimpleTeam in "requested_teams" field of PullRequest - [#453](https://github.com/phadej/github/pull/453) +- 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/phadej/github/pull/455) -- Update RepoWebhookEvent - [#461](https://github.com/phadej/github/pull/461) -- PullRequest Reviews may not have submitted_at field - [#450](https://github.com/phadej/github/pull/450) + [#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 -- Generalize PagedQuery to allow its reuse by preview github APIs - [#439](https://github.com/phadej/github/pull/439) +- 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/phadej/github/pull/445) + [#445](https://github.com/haskell-github/github/pull/445) - Add endpoint for users search - [#444](https://github.com/phadej/github/pull/444) -- Make repoWebhookResponseStatus optional - [#436](https://github.com/phadej/github/pull/436) + [#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/phadej/github/pull/417) -- Add deleteReference endpoint - [#388](https://github.com/phadej/github/pull/388) + [#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 - Add `executeRequestWithMgrAndRes` - [#421](https://github.com/phadej/github/pull/421) + [#421](https://github.com/haskell-github/github/pull/421) - Add `limitsFromHttpResponse` - [#421](https://github.com/phadej/github/pull/421) + [#421](https://github.com/haskell-github/github/pull/421) - Add label descriptions - [#418](https://github.com/phadej/github/pull/418) + [#418](https://github.com/haskell-github/github/pull/418) - Add "draft" option to mergeable state - [#431](https://github.com/phadej/github/pull/431) -- Use IssueNumber in editIssueR and issueR - [#429](https://github.com/phadej/github/pull/429) + [#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/phadej/github/pull/420) + [#420](https://github.com/haskell-github/github/pull/420) - Add support for collaborator permission endpoint - [#425](https://github.com/phadej/github/pull/425) + [#425](https://github.com/haskell-github/github/pull/425) - Add support for the comment reply endpoint - [#424](https://github.com/phadej/github/pull/424) + [#424](https://github.com/haskell-github/github/pull/424) - Organise exports in `GitHub` - [#430](https://github.com/phadej/github/pull/430) + [#430](https://github.com/haskell-github/github/pull/430) ## Changes for 0.24 @@ -53,122 +53,122 @@ 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/phadej/github/pull/415) +[#415](https://github.com/haskell-github/github/pull/415) - Remove double `withOpenSSL` - [#414](https://github.com/phadej/github/pull/414) + [#414](https://github.com/haskell-github/github/pull/414) - Pull requests reviews API uses issue number - [#409](https://github.com/phadej/github/pull/409) + [#409](https://github.com/haskell-github/github/pull/409) - Update `Repo`, `NewRepo` and `EditRepo` data types - [#407](https://github.com/phadej/github/pull/407) + [#407](https://github.com/haskell-github/github/pull/407) ## Changes for 0.23 - Escape URI paths - [#404](https://github.com/phadej/github/pull/404) -- Add OwnerBot to OwnerType - [#399](https://github.com/phadej/github/pull/399) -- Make File.fileSha optional - [#392](https://github.com/phadej/github/pull/392) + [#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/phadej/github/pull/403) - [#394](https://github.com/phadej/github/pull/394) + [#403](https://github.com/haskell-github/github/pull/403) + [#394](https://github.com/haskell-github/github/pull/394) ## Changes for 0.22 - Type-class for various auth methods - [#365](https://github.com/phadej/github/pull/365) + [#365](https://github.com/haskell-github/github/pull/365) - Throw on non-200 responses - [#350](https://github.com/phadej/github/pull/350) + [#350](https://github.com/haskell-github/github/pull/350) - Add extension point for (preview) media types - [#370](https://github.com/phadej/github/pull/370) + [#370](https://github.com/haskell-github/github/pull/370) - Add missing webhook event types - [#359](https://github.com/phadej/github/pull/359) + [#359](https://github.com/haskell-github/github/pull/359) - Add invitation endpoint - [#360](https://github.com/phadej/github/pull/360) + [#360](https://github.com/haskell-github/github/pull/360) - Add notifications endpoints - [#324](https://github.com/phadej/github/pull/324) + [#324](https://github.com/haskell-github/github/pull/324) - Add ssh keys endpoints - [#363](https://github.com/phadej/github/pull/365) + [#363](https://github.com/haskell-github/github/pull/365) - Case insensitive enum parsing - [#373](https://github.com/phadej/github/pull/373) + [#373](https://github.com/haskell-github/github/pull/373) - Don't try parse unitary responses - [#377](https://github.com/phadej/github/issues/377) + [#377](https://github.com/haskell-github/github/issues/377) - Update dependencies - [#364](https://github.com/phadej/github/pull/364) - [#368](https://github.com/phadej/github/pull/368) - [#369](https://github.com/phadej/github/pull/369) + [#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/phadej/github/pull/357) + [#357](https://github.com/haskell-github/github/pull/357) ## Changes for 0.21 - Refactor `Request` type. - [#349](https://github.com/phadej/github/pull/349) + [#349](https://github.com/haskell-github/github/pull/349) - Allow `http-client-0.6` - [#344](https://github.com/phadej/github/pull/344) + [#344](https://github.com/haskell-github/github/pull/344) - Change to use `cryptohash-sha1` (`cryptohash` was used before) -- Add Create milestone endponts - [#337](https://github.com/phadej/github/pull/337) -- Make fileBlobUrl and fileRawUrl are optional - [#339](https://github.com/phadej/github/issues/339) - [#340](https://github.com/phadej/github/pull/340) -- Add organizationsR to request user organizations - [#345](https://github.com/phadej/github/pull/345) -- Add updateMilestoneR, deleteMilestoneR - [#338](https://github.com/phadej/github/pull/338) -- Allow multiple assignees in NewIssue and EditIssue - [#336](https://github.com/phadej/github/pull/336) +- Add 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/phadej/github/pull/325) + [#325](https://github.com/haskell-github/github/pull/325) ## Changes for 0.20 - Add ratelimit endpoint - [#315](https://github.com/phadej/github/pull/315) + [#315](https://github.com/haskell-github/github/pull/315) - Add some deployment endoints - [#330](https://github.com/phadej/github/pull/330) + [#330](https://github.com/haskell-github/github/pull/330) - Add webhook installation events - [#329](https://github.com/phadej/github/pull/330) -- Tigthen lower bounds (also remove aeson-compat dep) - [#332](https://github.com/phadej/github/pull/332) + [#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 - Fix issue event type enumeration - [#301](https://github.com/phadej/github/issues/301) -- Include label info in `IssseEvent` - [#302](https://github.com/phadej/github/issues/302) + [#301](https://github.com/haskell-github/github/issues/301) +- Include label info in `IssueEvent` + [#302](https://github.com/haskell-github/github/issues/302) - Fix `ShowRepo` example - [#306](https://github.com/phadej/github/pull/306) + [#306](https://github.com/haskell-github/github/pull/306) - Add "Get archive link" API - [#307](https://github.com/phadej/github/pull/307) -- Make "repo" in PullRequestCommit nullable (repository can be gone) - [#311](https://github.com/phadej/github/pull/311) + [#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/phadej/github/pull/313) + [#313](https://github.com/haskell-github/github/pull/313) - Organisation membership API - [#312](https://github.com/phadej/github/pull/312) -- Fix isPullRequestMerged and other boolean responses - [#312](https://github.com/phadej/github/pull/312) + [#312](https://github.com/haskell-github/github/pull/312) +- Fix `isPullRequestMerged` and other boolean responses + [#312](https://github.com/haskell-github/github/pull/312) - Add `behind` pull request mergeable state - [#308](https://github.com/phadej/github/pull/308) + [#308](https://github.com/haskell-github/github/pull/308) - Add list organisation invitations endpoint ## Changes for 0.18 - Endpoints for deleting issue comments. - [#294](https://github.com/phadej/github/pull/294) + [#294](https://github.com/haskell-github/github/pull/294) - Endpoints for (un)starring gists. - [#296](https://github.com/phadej/github/pull/296) + [#296](https://github.com/haskell-github/github/pull/296) - Add `archived` field to `Repo`. - [#298](https://github.com/phadej/github/pull/298) + [#298](https://github.com/haskell-github/github/pull/298) - Update dependencies. - [#295](https://github.com/phadej/github/pull/295) + [#295](https://github.com/haskell-github/github/pull/295) - Add Statuses endpoints. - [#268](https://github.com/phadej/github/pull/268) + [#268](https://github.com/haskell-github/github/pull/268) - Add requested reviewers field to pull request records. - [#292](https://github.com/phadej/github/pull/292) + [#292](https://github.com/haskell-github/github/pull/292) ## Changes for 0.17.0 @@ -184,7 +184,7 @@ This reduces symbol bloat in the library. - Supports newest versions of dependencies - user events - release endpoints -- forkExistingRepo +- `forkExistingRepo` ## Changes for 0.15.0 @@ -197,16 +197,16 @@ This reduces symbol bloat in the library. - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` -- Add 'userIssuesR' -- Add 'organizationIssuesR' +- Add `userIssuesR` +- Add `organizationIssuesR` - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` -- Refactor 'Request' structure +- Refactor `Request` structure - Added multiple issue assignees - Preliminary support for repository events: `repositoryEventsR` - Support for adding repository permissions to the team -- Remove 'simpleUserType', it was always the same. +- Remove `simpleUserType`, it was always the same. -See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) +See [git commit summary](https://github.com/haskell-github/github/compare/v0.14.1...v0.15.0) ## Changes for 0.14.1 @@ -229,23 +229,23 @@ Large API changes: ## Changes for 0.5.0: -* OAuth. +* `OAuth`. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. -* Relax the attoparsec version requirements. +* Relax the `attoparsec` version requirements. * The above by [John Wiegley](https://github.com/jwiegley). ## Changes for 0.4.1: -* Stop using the uri package. -* Use aeson version 0.6.1.0. -* Use attoparsec version 0.10.3.0. -* Use http-conduit over 1.8. -* Use unordered-containers between 0.2 and 0.3. +* Stop using the `uri` package. +* Use `aeson` version 0.6.1.0. +* Use `attoparsec` version 0.10.3.0. +* Use `http-conduit` over 1.8. +* Use `unordered-containers` between 0.2 and 0.3. ## Changes for 0.4.0: -* Use http-conduit version 1.4.1.10. +* Use `http-conduit` version 1.4.1.10. ## Changes for 0.3.0: @@ -259,13 +259,13 @@ Large API changes: ## Changes for 0.2.1: -* 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: * `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/github.cabal b/github.cabal index 04cb2c9a..670a3d2d 100644 --- a/github.cabal +++ b/github.cabal @@ -18,13 +18,13 @@ description: > possibleUser <- GH.github' GH.userInfoForR "phadej" > print possibleUser . - For more of an overview please see the README: + 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 +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 @@ -48,7 +48,7 @@ extra-source-files: source-repository head type: git - location: git://github.com/phadej/github.git + location: git://github.com/haskell-github/github.git flag openssl description: "Use http-client-openssl" From 00a166f286fa296d14fb1a5f74cb0b6ed464a532 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 18:30:01 +0200 Subject: [PATCH 252/309] CONTRIBUTING: add testing requirement --- CONTRIBUTING.md | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 8bb941ef..dc10c361 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -15,13 +15,24 @@ For example: ```haskell -- | Get your current rate limit status. --- +-- rateLimitR :: Request k RateLimit rateLimitR = query ["rate_limit"] [] ``` Also re-export endpoints from the top `GitHub` module. *Note:* only `R` variants, not `IO`. +Testing +------- + +When adding new functionality, cover it by a test case in: + + spec/ + +or a demonstration added to: + + samples/github-samples.cabal + Miscellaneous ------------- From ebf466438a61297c6a38f725edb7ec1f4b950804 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 09:08:50 +0200 Subject: [PATCH 253/309] CHANGELOG: add release dates and authors --- CHANGELOG.md | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b7bcbc47..1f45068e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ ## 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 @@ -11,6 +13,8 @@ ## 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 @@ -26,6 +30,8 @@ ## Changes for 0.25 +_2020-02-18, Oleg Grenrus_ + - Add `executeRequestWithMgrAndRes` [#421](https://github.com/haskell-github/github/pull/421) - Add `limitsFromHttpResponse` @@ -47,6 +53,8 @@ ## 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`). @@ -64,6 +72,8 @@ This reduces symbol bloat in the library. ## 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` @@ -76,6 +86,8 @@ This reduces symbol bloat in the library. ## 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 @@ -103,6 +115,8 @@ This reduces symbol bloat in the library. ## 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` @@ -124,6 +138,8 @@ This reduces symbol bloat in the library. ## 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 @@ -135,6 +151,8 @@ This reduces symbol bloat in the library. ## 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` @@ -157,6 +175,8 @@ This reduces symbol bloat in the library. ## 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. @@ -172,6 +192,8 @@ This reduces symbol bloat in the library. ## Changes for 0.17.0 +_2017-09-26, Oleg Grenrus_ + - Add `Ord Request` instance - Repository contents - Repository starring endpoints @@ -179,6 +201,8 @@ This reduces symbol bloat in the library. ## 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 @@ -188,6 +212,8 @@ This reduces symbol bloat in the library. ## Changes for 0.15.0 +_2016-11-04, Oleg Grenrus_ + - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering - GHC-8.0.1 support @@ -210,6 +236,8 @@ See [git commit summary](https://github.com/haskell-github/github/compare/v0.14. ## Changes for 0.14.1 +_2016-02-02, Oleg Grenrus_ + - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` - Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, @@ -218,6 +246,8 @@ See [git commit summary](https://github.com/haskell-github/github/compare/v0.14. ## Changes for 0.14.0 +_2016-01-25, Oleg Grenrus_ + Large API changes: - Use `Text` and `Vector` in place of `String` and `[]`. @@ -227,8 +257,30 @@ Large API changes: - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. +## Releases without changelog + +| Version | Date | Uploader | +|---|---|---| +| __0.13.2__ | _2015-04-26_ | _John Wiegley_ | +| __0.13.1__ | _2014-12-01_ | _César López-Natarén_ | +| __0.13__ | _2014-11-09_ | _César López-Natarén_ | +| __0.12__ | _2014-11-09_ | _César López-Natarén_ | +| __0.11.1__ | _2014-09-07_ | _César López-Natarén_ | +| __0.11.0__ | _2014-08-25_ | _César López-Natarén_ | +| __0.10.0__ | _2014-08-18_ | _César López-Natarén_ | +| __0.9__ | _2014-07-31_ | _John Wiegley_ | +| __0.8__ | _2014-05-02_ | _John Wiegley_ | +| __0.7.4__ | _2014-01-22_ | _John Wiegley_ | +| __0.7.3__ | _2013-12-21_ | _John Wiegley_ | +| __0.7.2__ | _2013-12-02_ | _John Wiegley_ | +| __0.7.1__ | _2013-08-08_ | _John Wiegley_ | +| __0.7.0__ | _2013-04-26_ | _John Wiegley_ | +| __0.6.0__ | _2013-04-12_ | _John Wiegley_ | + ## Changes for 0.5.0: +_2013-02-05, Mike Burns_ + * `OAuth`. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. @@ -237,6 +289,8 @@ Large API changes: ## 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. @@ -245,10 +299,14 @@ Large API changes: ## Changes for 0.4.0: +_2012-06-26, Mike Burns_ + * Use `http-conduit` version 1.4.1.10. ## Changes for 0.3.0: +_2012-06-10, Mike Burns_ + * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. * Add `deleteRepo`, `editRepo`, and `createRepo`. @@ -259,10 +317,14 @@ Large API changes: ## Changes for 0.2.1: +_2012-02-16, Mike Burns_ + * Expand the `unordered-containers` dependency to anything in 0.1.x . ## Changes for 0.2.0: +_2012-02-15, Mike Burns_ + * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names. * Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names. From cbd8d2b6fa33eace60a3a3accbed3823f9e70564 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 09:44:05 +0200 Subject: [PATCH 254/309] Allow text-2.0 --- cabal.project | 8 ++------ github.cabal | 2 +- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/cabal.project b/cabal.project index b9ac7eb6..3e6d3d45 100644 --- a/cabal.project +++ b/cabal.project @@ -4,12 +4,8 @@ packages: samples optimization: False tests: True -constraints: hashable >=1.3 -constraints: semigroups ^>=0.19 - constraints: github +openssl constraints: github-samples +openssl -allow-newer: deepseq-generics-0.2.0.0:base -allow-newer: deepseq-generics-0.2.0.0:ghc-prim -allow-newer: HsOpenSSL:bytestring +constraints: text >=2 +allow-newer: *:text diff --git a/github.cabal b/github.cabal index 670a3d2d..868629d4 100644 --- a/github.cabal +++ b/github.cabal @@ -171,7 +171,7 @@ library , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 - , text >=1.2.0.6 && <1.3 + , text >=1.2.0.6 && <2.1 , time-compat >=1.9.2.2 && <1.10 , transformers >=0.3.0.0 && <0.6 From f371051bce54b702268029dff6a9a03783f11c91 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 10:19:22 +0200 Subject: [PATCH 255/309] Use repo haskell-github/github in specs and samples Repo moved from phadej/github. --- samples/Activity/Starring/StarRepo.hs | 2 +- samples/Activity/Starring/UnstarRepo.hs | 2 +- samples/Operational/Operational.hs | 2 +- spec/GitHub/ActivitySpec.hs | 2 +- spec/GitHub/CommitsSpec.hs | 8 ++++---- spec/GitHub/EventsSpec.hs | 2 +- spec/GitHub/IssuesSpec.hs | 4 ++-- spec/GitHub/PullRequestReviewsSpec.hs | 2 +- spec/GitHub/PullRequestsSpec.hs | 8 ++++---- spec/GitHub/ReposSpec.hs | 6 +++--- spec/GitHub/SearchSpec.hs | 2 +- spec/GitHub/UsersSpec.hs | 2 +- 12 files changed, 21 insertions(+), 21 deletions(-) diff --git a/samples/Activity/Starring/StarRepo.hs b/samples/Activity/Starring/StarRepo.hs index 452aaf7b..1174c380 100644 --- a/samples/Activity/Starring/StarRepo.hs +++ b/samples/Activity/Starring/StarRepo.hs @@ -8,7 +8,7 @@ import qualified Data.Text.IO as T main :: IO () main = do - let owner = "phadej" + let owner = "haskell-github" repo = "github" result <- GH.starRepo (GH.OAuth "your-token") (GH.mkOwnerName owner) (GH.mkRepoName repo) diff --git a/samples/Activity/Starring/UnstarRepo.hs b/samples/Activity/Starring/UnstarRepo.hs index 29d68dd1..3ecfe196 100644 --- a/samples/Activity/Starring/UnstarRepo.hs +++ b/samples/Activity/Starring/UnstarRepo.hs @@ -8,7 +8,7 @@ import qualified Data.Text.IO as T main :: IO () main = do - let owner = "phadej" + let owner = "haskell-github" repo = "github" result <- GH.unstarRepo (GH.OAuth "your-token") (GH.mkOwnerName owner) (GH.mkRepoName repo) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 4e669ff4..cbfc9fb4 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -47,7 +47,7 @@ main = GH.withOpenSSL $ do script :: Program R (GH.Owner, GH.Limits) script = do - repo <- githubRequest $ GH.repositoryR "phadej" "github" + 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/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 73b044a0..43b3c234 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -30,7 +30,7 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll + cs <- executeRequest auth $ watchersForR "haskell-github" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 5bf2d6a0..97f8c386 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -30,13 +30,13 @@ spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do - cs <- github auth commitsForR "phadej" "github" FetchAll + cs <- github auth commitsForR "haskell-github" "github" FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do - cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 40) + cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -45,12 +45,12 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 30) + cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits forM_ pairs $ \(a, b) -> do - d <- github 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 diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs index ae51a1a2..fee7f50e 100644 --- a/spec/GitHub/EventsSpec.hs +++ b/spec/GitHub/EventsSpec.hs @@ -27,7 +27,7 @@ spec :: Spec spec = do describe "repositoryEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ - GitHub.repositoryEventsR "phadej" "github" 1 + GitHub.repositoryEventsR "haskell-github" "github" 1 describe "userEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 where shouldSucceed f = withAuth $ \auth -> do diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 2ed08278..2a7f5e7b 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -41,10 +41,10 @@ spec = do describe "issueR" $ do it "fetches issue #428" $ withAuth $ \auth -> do resIss <- GitHub.executeRequest auth $ - GitHub.issueR "phadej" "github" (GitHub.IssueNumber 428) + GitHub.issueR "haskell-github" "github" (GitHub.IssueNumber 428) resIss `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") + , ("haskell-github", "github") ] diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index 8721efc9..1aed07e4 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -29,4 +29,4 @@ spec = do cs `shouldSatisfy` isRight where prs = - [("phadej", "github", IssueNumber 268)] + [("haskell-github", "github", IssueNumber 268)] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 7a49bc97..05945d01 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -47,7 +47,7 @@ spec = do describe "pullRequestPatchR" $ it "works" $ withAuth $ \auth -> do Right patch <- GH.executeRequest auth $ - GH.pullRequestPatchR "phadej" "github" (GH.IssueNumber 349) + 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 @@ -74,21 +74,21 @@ spec = do describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GH.executeRequest auth $ GH.isPullRequestMergedR "phadej" "github" (GH.IssueNumber 14) + b <- 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 "phadej" "github" opts GH.FetchAll + draftPullRequestsForR "haskell-github" "github" opts GH.FetchAll cs `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") + , ("haskell-github", "github") ] opts = GH.stateClosed diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index a08ca00d..45c32415 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -29,10 +29,10 @@ spec :: Spec spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do - er <- github auth repositoryR "phadej" "github" + er <- github auth repositoryR "haskell-github" "github" er `shouldSatisfy` isRight let Right r = er - -- https://github.com/phadej/github/pull/219 + -- https://github.com/haskell-github/github/pull/219 repoDefaultBranch r `shouldBe` Just "master" describe "currentUserRepos" $ do @@ -47,6 +47,6 @@ spec = do describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do - ls <- github auth languagesForR "phadej" "github" + ls <- github auth languagesForR "haskell-github" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index f82a2051..23c6b7a9 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -54,7 +54,7 @@ spec = do 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" + 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 diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index abb2a882..0b1913f5 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -67,7 +67,7 @@ spec = do (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" describe "userInfoCurrentR" $ do - it "returns information about the autenticated user" $ withAuth $ \auth -> do + it "returns information about the authenticated user" $ withAuth $ \auth -> do userInfo <- github auth userInfoCurrentR userInfo `shouldSatisfy` isRight From 8b282c729db67e9c273785d3a6ff093eb2f89347 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 10:37:38 +0200 Subject: [PATCH 256/309] Fix warning introduced by #474 --- src/GitHub/Data/Search.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index 951d1c83..96b9f2c8 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -32,7 +32,7 @@ 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 + foldMap f (SearchResult _count results) = f results data Code = Code { codeName :: !Text From e63d4ac814c0e074ca32067a249e79b6f0928546 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 11:10:18 +0200 Subject: [PATCH 257/309] README: link to github-rest (alternative solution) --- README.md | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 18313f24..8deb6bf1 100644 --- a/README.md +++ b/README.md @@ -16,14 +16,13 @@ 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 @@ -94,3 +93,11 @@ Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. [hackage]: http://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 From d9ac0c7ffbcc720a24d06f0a96ea4e3891316d1a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 10:30:06 +0200 Subject: [PATCH 258/309] Bump to 0.28; CHANGELOG for v0.28 --- CHANGELOG.md | 27 +++++++++++++++++++++++++++ README.md | 2 +- github.cabal | 4 ++-- 3 files changed, 30 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1f45068e..f5bdfaaf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,30 @@ +## 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_ diff --git a/README.md b/README.md index 8deb6bf1..6203a7b5 100644 --- a/README.md +++ b/README.md @@ -39,7 +39,7 @@ 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 which can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` diff --git a/github.cabal b/github.cabal index 868629d4..b00fa5ef 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.27.1 +version: 0.28 synopsis: Access to the GitHub API, v3. category: Network description: @@ -23,7 +23,7 @@ description: license: BSD3 license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus -maintainer: Oleg Grenrus +maintainer: Andreas Abel homepage: https://github.com/haskell-github/github build-type: Simple copyright: From 9aa9839a2a1e5e80e9b6d6f61c8288675a1ecede Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 22 May 2022 16:36:45 +0200 Subject: [PATCH 259/309] Relax upper bounds: hspec(-discover), mtl, transformers --- github.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/github.cabal b/github.cabal index b00fa5ef..2bfb954e 100644 --- a/github.cabal +++ b/github.cabal @@ -170,10 +170,10 @@ library , bytestring >=0.10.4.0 && <0.12 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 - , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 + , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 , text >=1.2.0.6 && <2.1 , time-compat >=1.9.2.2 && <1.10 - , transformers >=0.3.0.0 && <0.6 + , transformers >=0.3.0.0 && <0.7 -- other packages build-depends: @@ -216,7 +216,7 @@ test-suite github-test hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded - build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.10 + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.11 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec @@ -241,7 +241,7 @@ test-suite github-test , bytestring , file-embed , github - , hspec >=2.6.1 && <2.10 + , hspec >=2.6.1 && <2.11 , tagged , text , unordered-containers From 7107546062e39348f187d54ce060e0fcb9c1437d Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 22 May 2022 16:55:32 +0200 Subject: [PATCH 260/309] Update Haskell-CI Tried to add constraint-set for mtl-2.3 / transformers-0.6 but time isn't ripe for this yet (some deps do not allow mtl-2.3). --- .github/workflows/haskell-ci.yml | 13 ++++--------- cabal.haskell-ci | 9 +++++++++ cabal.project | 4 ++-- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index bbd13145..58b17373 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.14.3.20220416 +# version: 0.15.20220504 # -# REGENDATA ("0.14.3.20220416",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20220504",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -23,7 +23,7 @@ on: jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} - runs-on: ubuntu-18.04 + runs-on: ubuntu-20.04 timeout-minutes: 60 container: @@ -217,13 +217,8 @@ jobs: if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <=1.3 - constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl - allow-newer: deepseq-generics-0.2.0.0:base - allow-newer: deepseq-generics-0.2.0.0:ghc-prim - allow-newer: HsOpenSSL:bytestring optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local @@ -260,7 +255,7 @@ jobs: if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | - if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi + if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi - name: unconstrained build run: | rm -f cabal.project.local diff --git a/cabal.haskell-ci b/cabal.haskell-ci index eb8a2be2..a937b18a 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -2,3 +2,12 @@ branches: master haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any + +-- 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 \ No newline at end of file diff --git a/cabal.project b/cabal.project index 3e6d3d45..4b4ee992 100644 --- a/cabal.project +++ b/cabal.project @@ -7,5 +7,5 @@ tests: True constraints: github +openssl constraints: github-samples +openssl -constraints: text >=2 -allow-newer: *:text +-- constraints: text >=2 +-- allow-newer: *:text From 2425a1576d2a1f9f954f18a1e2d9d20c95ef0a4c Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 28 May 2022 18:43:32 +0200 Subject: [PATCH 261/309] Drop unused dependency vector-instances --- github.cabal | 4 ++-- src/GitHub/Internal/Prelude.hs | 1 - 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/github.cabal b/github.cabal index 2bfb954e..0d8d45e9 100644 --- a/github.cabal +++ b/github.cabal @@ -40,6 +40,7 @@ tested-with: || ==8.10.7 || ==9.0.2 || ==9.2.2 + || ==9.4.1 extra-source-files: README.md @@ -165,7 +166,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.17 + base >=4.7 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.12 , containers >=0.5.5.1 && <0.7 @@ -194,7 +195,6 @@ library , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 - , vector-instances >=3.4 && <3.5 if flag(openssl) build-depends: diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 2ac8633c..1994abac 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -57,6 +57,5 @@ import Data.Text (Text, pack, unpack) import Data.Time.Compat (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import Data.Vector.Instances () import GHC.Generics (Generic) import Prelude.Compat From d9fce57138ff5db8e2500b21caa76b363e524696 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 28 May 2022 19:46:56 +0200 Subject: [PATCH 262/309] Haskell-CI: include 9.4 alpha --- .github/workflows/haskell-ci.yml | 42 +++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 11 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 58b17373..9c414512 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20220504 +# version: 0.15.20220525 # -# REGENDATA ("0.15.20220504",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20220525",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,6 +32,11 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.4.0.20220501 + compilerKind: ghc + compilerVersion: 9.4.0.20220501 + setup-method: ghcup + allow-failure: true - compiler: ghc-9.2.2 compilerKind: ghc compilerVersion: 9.2.2 @@ -90,8 +95,9 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + if $HEADHACKAGE; then "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; fi "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 else @@ -99,7 +105,7 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 fi @@ -132,7 +138,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -161,6 +167,17 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -211,16 +228,19 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -251,8 +271,8 @@ jobs: run: | cd ${PKGDIR_github} || false ${CABAL} -vnormal check - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi From 299ad10ea23d9df5819f5e64dec9dd664ba74bb7 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 28 May 2022 19:56:22 +0200 Subject: [PATCH 263/309] LANGUAGE TypeOperators for GHC 9.4 --- github.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/github.cabal b/github.cabal index 0d8d45e9..e02094c6 100644 --- a/github.cabal +++ b/github.cabal @@ -72,6 +72,7 @@ library DeriveGeneric OverloadedStrings ScopedTypeVariables + TypeOperators other-extensions: CPP From 01c115466d0fe0b879dd16d85d3a730a4142eaae Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 16 Jun 2022 11:47:58 +0200 Subject: [PATCH 264/309] Allow aeson-2.1 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index e02094c6..f10beef5 100644 --- a/github.cabal +++ b/github.cabal @@ -179,7 +179,7 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.1 + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.2 , base-compat >=0.11.1 && <0.13 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 From ae33fd36a982b3d5ef55fed4d643910ecd96a984 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 23 Jul 2022 10:50:07 +0200 Subject: [PATCH 265/309] Haskell-CI: bump to 9.2.3 --- .github/workflows/haskell-ci.yml | 35 +++++++++++++++++--------------- cabal.haskell-ci | 2 +- github.cabal | 22 ++++++++++---------- samples/github-samples.cabal | 22 +++++++++++--------- 4 files changed, 43 insertions(+), 38 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 9c414512..ff536274 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,18 +8,20 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20220525 +# version: 0.15.20220710 # -# REGENDATA ("0.15.20220525",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20220710",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: push: branches: - master + - ci* pull_request: branches: - master + - ci* jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} @@ -32,14 +34,14 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.0.20220501 + - compiler: ghc-9.4.0.20220623 compilerKind: ghc - compilerVersion: 9.4.0.20220501 + compilerVersion: 9.4.0.20220623 setup-method: ghcup allow-failure: true - - compiler: ghc-9.2.2 + - compiler: ghc-9.2.3 compilerKind: ghc - compilerVersion: 9.2.2 + compilerVersion: 9.2.3 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -97,9 +99,9 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - if $HEADHACKAGE; then "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; fi - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update @@ -107,7 +109,7 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -176,6 +178,7 @@ jobs: 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329 f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89 key-threshold: 3 + active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override EOF fi cat >> $CABAL_CONFIG <> cabal.project - if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -228,11 +231,11 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi diff --git a/cabal.haskell-ci b/cabal.haskell-ci index a937b18a..a3ce9738 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,4 +1,4 @@ -branches: master +branches: master ci* haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any diff --git a/github.cabal b/github.cabal index f10beef5..a1fa6a11 100644 --- a/github.cabal +++ b/github.cabal @@ -30,17 +30,17 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.7 - || ==9.0.2 - || ==9.2.2 - || ==9.4.1 + GHC == 9.4.1 + GHC == 9.2.3 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 + GHC == 7.8.4 extra-source-files: README.md diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 43b5ac3c..9efe9889 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -5,19 +5,21 @@ category: Examples synopsis: Samples for github package license: BSD-3-Clause license-file: LICENSE -maintainer: Oleg Grenrus +maintainer: Andreas Abel description: Various samples of github package build-type: Simple + tested-with: - GHC ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.7 - || ==9.0.2 - || ==9.2.2 + GHC == 9.4.1 + GHC == 9.2.3 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 library hs-source-dirs: src From bdae4911d698a107f19ceb54751733baa66f84f3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 23 Jul 2022 10:50:53 +0200 Subject: [PATCH 266/309] Fix #485: allow vector-0.13 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index a1fa6a11..3fe795d7 100644 --- a/github.cabal +++ b/github.cabal @@ -195,7 +195,7 @@ library , tagged >=0.8.5 && <0.9 , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 - , vector >=0.12.0.1 && <0.13 + , vector >=0.12.0.1 && <0.14 if flag(openssl) build-depends: From 5c897573216503d5cc8ac7b73a60e4c18dbf9c4b Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 23 Jul 2022 10:51:23 +0200 Subject: [PATCH 267/309] Bump to 0.28.0.1 and CHANGELOG --- CHANGELOG.md | 9 +++++++++ github.cabal | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f5bdfaaf..f402d4d1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## 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_ diff --git a/github.cabal b/github.cabal index 3fe795d7..56a062f7 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.28 +version: 0.28.0.1 synopsis: Access to the GitHub API, v3. category: Network description: From 28c74236049f7ae820e47d9c095648cd83ba0e0c Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Mon, 24 Oct 2022 19:49:06 +0200 Subject: [PATCH 268/309] Bump CI to 9.4.2 --- .github/workflows/haskell-ci.yml | 36 +++++++++----------------------- github.cabal | 4 ++-- samples/github-samples.cabal | 4 ++-- 3 files changed, 14 insertions(+), 30 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index ff536274..f141f271 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20220710 +# version: 0.15.20221009 # -# REGENDATA ("0.15.20220710",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20221009",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,14 +34,14 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.0.20220623 + - compiler: ghc-9.4.2 compilerKind: ghc - compilerVersion: 9.4.0.20220623 + compilerVersion: 9.4.2 setup-method: ghcup - allow-failure: true - - compiler: ghc-9.2.3 + allow-failure: false + - compiler: ghc-9.2.4 compilerKind: ghc - compilerVersion: 9.2.3 + compilerVersion: 9.2.4 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -97,9 +97,8 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else @@ -107,7 +106,7 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi @@ -140,7 +139,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -169,18 +168,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 56a062f7..b500a190 100644 --- a/github.cabal +++ b/github.cabal @@ -30,8 +30,8 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.4.1 - GHC == 9.2.3 + GHC == 9.4.2 + GHC == 9.2.4 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 9efe9889..d95d5a8e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,8 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.4.1 - GHC == 9.2.3 + GHC == 9.4.2 + GHC == 9.2.4 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From ed296cb891d9d41b81bc3a292432e2c55cc014dc Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 19 Feb 2023 21:07:19 +0100 Subject: [PATCH 269/309] Bump CI to GHC 9.6.0 (#491) No code changes needed for GHC 9.6. --- .github/workflows/haskell-ci.yml | 59 ++++++++++++++++++++++++-------- cabal.project | 1 + github.cabal | 5 +-- samples/github-samples.cabal | 5 +-- 4 files changed, 51 insertions(+), 19 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index f141f271..ea1a4e23 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20221009 +# version: 0.15.20230217 # -# REGENDATA ("0.15.20221009",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20230217",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,14 +34,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.2 + - compiler: ghc-9.6.0.20230210 compilerKind: ghc - compilerVersion: 9.4.2 + compilerVersion: 9.6.0.20230210 + setup-method: ghcup + allow-failure: true + - compiler: ghc-9.4.4 + compilerKind: ghc + compilerVersion: 9.4.4 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.4 + - compiler: ghc-9.2.6 compilerKind: ghc - compilerVersion: 9.2.4 + compilerVersion: 9.2.6 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -99,8 +104,9 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update @@ -108,7 +114,8 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; + "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -126,20 +133,20 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" fi 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" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90600)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -168,6 +175,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -235,8 +258,8 @@ jobs: run: | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - - name: cache - uses: actions/cache@v2 + - name: restore cache + uses: actions/cache/restore@v3 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -262,8 +285,14 @@ jobs: if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | - if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi + 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 + uses: actions/cache/save@v3 + if: always() + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store diff --git a/cabal.project b/cabal.project index 4b4ee992..ed0996f6 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ tests: True constraints: github +openssl constraints: github-samples +openssl +constraints: operational -buildExamples -- constraints: text >=2 -- allow-newer: *:text diff --git a/github.cabal b/github.cabal index b500a190..c7f85389 100644 --- a/github.cabal +++ b/github.cabal @@ -30,8 +30,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.4.2 - GHC == 9.2.4 + GHC == 9.6.0 + GHC == 9.4.4 + GHC == 9.2.6 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index d95d5a8e..72fe6368 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.4.2 - GHC == 9.2.4 + GHC == 9.6.0 + GHC == 9.4.4 + GHC == 9.2.6 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From a6a312601cad1843e418ce14d34c5099b54a41d0 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 12 Mar 2023 19:05:51 +0100 Subject: [PATCH 270/309] v0.28.0.1 Revision 1: Allow base-compat-0.13 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index c7f85389..5f1c7eea 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,7 @@ cabal-version: >=1.10 name: github version: 0.28.0.1 +x-revision: 1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -181,7 +182,7 @@ library -- other packages build-depends: aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.2 - , base-compat >=0.11.1 && <0.13 + , base-compat >=0.11.1 && <0.14 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 From 9944c53927b5ee5757de0b91888713f2c8f9e031 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 23 Apr 2023 19:50:33 +0200 Subject: [PATCH 271/309] Update badges --- README.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 6203a7b5..3ead9b24 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,10 @@ 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) -[![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] The GitHub API v3 for Haskell. @@ -92,7 +94,7 @@ 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 =========== From f63f92c46b3980d06c87959009af21628d06e8a2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 23 Apr 2023 19:44:20 +0200 Subject: [PATCH 272/309] Bump hspec to allow 2.11 --- .github/workflows/haskell-ci.yml | 49 +++++++++++--------------------- github.cabal | 12 ++++---- samples/github-samples.cabal | 4 +-- 3 files changed, 24 insertions(+), 41 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index ea1a4e23..d4898756 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20230217 +# version: 0.16 # -# REGENDATA ("0.15.20230217",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.16",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,19 +34,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.0.20230210 + - compiler: ghc-9.6.1 compilerKind: ghc - compilerVersion: 9.6.0.20230210 + compilerVersion: 9.6.1 setup-method: ghcup - allow-failure: true + allow-failure: false - compiler: ghc-9.4.4 compilerKind: ghc compilerVersion: 9.4.4 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.6 + - compiler: ghc-9.2.7 compilerKind: ghc - compilerVersion: 9.2.6 + compilerVersion: 9.2.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -102,20 +102,18 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; - "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -133,20 +131,20 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" fi 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 >= 90600)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -175,18 +173,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz - echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - + curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > 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 @@ -248,9 +234,6 @@ jobs: constraints: operational -buildExamples optimization: False EOF - if $HEADHACKAGE; then - echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 5f1c7eea..6ecbaab9 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: github version: 0.28.0.1 -x-revision: 1 +x-revision: 2 synopsis: Access to the GitHub API, v3. category: Network description: @@ -31,9 +31,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.6.0 + GHC == 9.6.1 GHC == 9.4.4 - GHC == 9.2.6 + GHC == 9.2.7 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 @@ -51,7 +51,7 @@ extra-source-files: source-repository head type: git - location: git://github.com/haskell-github/github.git + location: https://github.com/haskell-github/github.git flag openssl description: "Use http-client-openssl" @@ -219,7 +219,7 @@ test-suite github-test hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded - build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.11 + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.12 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec @@ -244,7 +244,7 @@ test-suite github-test , bytestring , file-embed , github - , hspec >=2.6.1 && <2.11 + , hspec >=2.6.1 && <2.12 , tagged , text , unordered-containers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 72fe6368..c758130e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,9 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.6.0 + GHC == 9.6.1 GHC == 9.4.4 - GHC == 9.2.6 + GHC == 9.2.7 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From 568ede6ed0460cf3c56009d6465ac729112f4ed1 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 13:18:55 +0200 Subject: [PATCH 273/309] Bump Haskell CI to GHC 9.6.2 9.4.5 9.2.8 --- .github/workflows/haskell-ci.yml | 16 ++++++++-------- github.cabal | 6 +++--- samples/github-samples.cabal | 6 +++--- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index d4898756..7a5b1d89 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.16 +# version: 0.16.4 # -# REGENDATA ("0.16",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.16.4",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,19 +34,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.1 + - compiler: ghc-9.6.2 compilerKind: ghc - compilerVersion: 9.6.1 + compilerVersion: 9.6.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.4 + - compiler: ghc-9.4.5 compilerKind: ghc - compilerVersion: 9.4.4 + compilerVersion: 9.4.5 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.7 + - compiler: ghc-9.2.8 compilerKind: ghc - compilerVersion: 9.2.7 + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 diff --git a/github.cabal b/github.cabal index 6ecbaab9..34389c64 100644 --- a/github.cabal +++ b/github.cabal @@ -31,9 +31,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.6.1 - GHC == 9.4.4 - GHC == 9.2.7 + GHC == 9.6.2 + GHC == 9.4.5 + GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c758130e..c76d6b14 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,9 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.6.1 - GHC == 9.4.4 - GHC == 9.2.7 + GHC == 9.6.2 + GHC == 9.4.5 + GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From 445c8de7300b25b51a4c6850e9468dcb6bc7f534 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 14:23:10 +0200 Subject: [PATCH 274/309] Resurrect samples/Issues/ShowRepoIssues This example wasn't ported to the new API. Now it is, with some ugly `show`s still. --- .github/workflows/haskell-ci.yml | 12 +++++----- samples/Issues/ShowRepoIssues.hs | 38 ++++++++++++++++++++------------ samples/github-samples.cabal | 11 +++++---- 3 files changed, 37 insertions(+), 24 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 7a5b1d89..b5d24eb9 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -203,7 +203,7 @@ jobs: run: | touch cabal.project echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -223,11 +223,11 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + 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" >> cabal.project ; fi cat >> cabal.project <= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + 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 diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index b6f26e68..3bfaa4ba 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -1,21 +1,31 @@ -module ShowRepoIssue where +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Issues as Github +import qualified GitHub as Github import Data.List (intercalate) +import Data.Foldable (toList) +main :: IO () main = do - let limitations = [Github.OnlyClosed, Github.Mentions "mike-burns", Github.AssignedTo "jyurek"] - possibleIssues <- Github.issuesForRepo "thoughtbot" "paperclip" limitations + let filt = Github.stateClosed <> Github.optionsMentioned "mike-burns" <> Github.optionsAssignee "jyurek" + possibleIssues <- Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll case possibleIssues of - (Left error) -> putStrLn $ "Error: " ++ show error - (Right issues) -> - putStrLn $ intercalate "\n\n" $ map formatIssue issues + Left err -> putStrLn $ "Error: " ++ show err + Right issues -> + putStrLn $ intercalate "\n\n" $ map formatIssue $ toList 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) +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 + , " with " + , show $ Github.issueComments issue + , " comments.\n\n" + + , show $ Github.issueTitle issue + ] diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c76d6b14..c3c6813d 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -18,15 +18,13 @@ tested-with: GHC == 8.8.4 GHC == 8.6.5 GHC == 8.4.4 - GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 library hs-source-dirs: src ghc-options: -Wall build-depends: - , base >=4.7 && <5 + , base >=4.11 && <5 + -- require base-4.11 because then (<>) is in Prelude , base-compat-batteries , github , text @@ -149,6 +147,11 @@ executable github-list-team-current -- main-is: ShowDeployKey.hs -- hs-source-dirs: Repos/DeployKeys +executable github-show-repo-issues + import: deps + main-is: ShowRepoIssues.hs + hs-source-dirs: Issues + executable github-show-user import: deps main-is: ShowUser.hs From 723884baa49627fe24424c493ba4c6436df53492 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 14:39:03 +0200 Subject: [PATCH 275/309] Parse `state_reason` (values: completed, not_planned, reopened) Added `issueStateReason` to `Issue`. --- CHANGELOG.md | 10 ++++++++++ github.cabal | 4 ++-- samples/Issues/ShowRepoIssues.hs | 25 ++++++++++++++++++------- src/GitHub/Data/Issues.hs | 4 +++- src/GitHub/Data/Options.hs | 25 +++++++++++++++++++++++++ 5 files changed, 58 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f402d4d1..1fa91d95 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## Changes for 0.29 + +_2022-06-24, Andreas Abel, Midsommar edition_ + +- 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_ diff --git a/github.cabal b/github.cabal index 34389c64..a0669042 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.28.0.1 -x-revision: 2 +version: 0.29 synopsis: Access to the GitHub API, v3. category: Network description: @@ -72,6 +71,7 @@ library DataKinds DeriveDataTypeable DeriveGeneric + LambdaCase OverloadedStrings ScopedTypeVariables TypeOperators diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index 3bfaa4ba..5f54026b 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -1,17 +1,27 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -import qualified GitHub 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 filt = Github.stateClosed <> Github.optionsMentioned "mike-burns" <> Github.optionsAssignee "jyurek" - possibleIssues <- Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll - case possibleIssues of - Left err -> putStrLn $ "Error: " ++ show err - Right issues -> - putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues + 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 @@ -23,6 +33,7 @@ formatIssue issue = concat , "It is currently " , show $ Github.issueState issue + , maybe "" (\ r -> " with reason " ++ show r) $ Github.issueStateReason issue , " with " , show $ Github.issueComments issue , " comments.\n\n" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 6e98da8f..3ec17781 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -9,7 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name) -import GitHub.Data.Options (IssueState) +import GitHub.Data.Options (IssueState, IssueStateReason) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude @@ -36,6 +36,7 @@ data Issue = Issue , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) + , issueStateReason :: !(Maybe IssueStateReason) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -203,6 +204,7 @@ instance FromJSON Issue where <*> o .: "id" <*> o .: "comments" <*> o .:? "milestone" + <*> o .:? "state_reason" instance ToJSON NewIssue where toJSON (NewIssue t b a m ls) = object $ filter notNull diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 24bc4369..5d27e0b1 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -50,6 +50,7 @@ module GitHub.Data.Options ( optionsAssignee, -- * Data IssueState (..), + IssueStateReason (..), MergeableState (..), -- * Internal HasState, @@ -94,6 +95,30 @@ instance FromJSON IssueState where instance NFData IssueState where rnf = genericRnf instance Binary IssueState +-- | 'GitHub.Data.Issues.Issue' state reason +data IssueStateReason + = StateReasonCompleted + | StateReasonNotPlanned + | StateReasonReopened + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON IssueStateReason where + toJSON = String . \case + StateReasonCompleted -> "completed" + StateReasonNotPlanned -> "not_planned" + StateReasonReopened -> "reopened" + +instance FromJSON IssueStateReason where + parseJSON = withText "IssueStateReason" $ \t -> case T.toLower t of + "completed" -> pure StateReasonCompleted + "not_planned" -> pure StateReasonNotPlanned + "reopened" -> pure StateReasonReopened + _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t + +instance NFData IssueStateReason where rnf = genericRnf +instance Binary IssueStateReason + -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state data MergeableState = StateUnknown From a2739ee3821a41ccf0686ae4f797575ff74adb81 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 16:57:41 +0200 Subject: [PATCH 276/309] Remove outdated maintainer from module headers --- src/GitHub.hs | 6 +----- src/GitHub/Auth.hs | 5 ----- src/GitHub/Data.hs | 6 ++---- src/GitHub/Data/Activities.hs | 6 ------ src/GitHub/Data/Comments.hs | 5 ----- src/GitHub/Data/Content.hs | 6 +----- src/GitHub/Data/Definitions.hs | 5 ----- src/GitHub/Data/Email.hs | 5 ----- src/GitHub/Data/Enterprise.hs | 5 +---- src/GitHub/Data/Enterprise/Organizations.hs | 5 ----- src/GitHub/Data/Events.hs | 6 +----- src/GitHub/Data/Gists.hs | 5 ----- src/GitHub/Data/GitData.hs | 5 ----- src/GitHub/Data/Id.hs | 5 ----- src/GitHub/Data/Invitation.hs | 5 ----- src/GitHub/Data/Issues.hs | 5 ----- src/GitHub/Data/Milestone.hs | 5 ----- src/GitHub/Data/Name.hs | 5 ----- src/GitHub/Data/Options.hs | 6 ++---- src/GitHub/Data/PullRequests.hs | 5 ----- src/GitHub/Data/RateLimit.hs | 5 ----- src/GitHub/Data/Repos.hs | 6 ++---- src/GitHub/Data/Request.hs | 6 +----- src/GitHub/Data/Search.hs | 5 ----- src/GitHub/Data/Teams.hs | 6 +----- src/GitHub/Data/URL.hs | 5 ----- src/GitHub/Data/Webhooks.hs | 5 ----- src/GitHub/Data/Webhooks/Validate.hs | 5 +---- src/GitHub/Endpoints/Activity/Events.hs | 5 +---- src/GitHub/Endpoints/Activity/Notifications.hs | 4 ---- src/GitHub/Endpoints/Activity/Starring.hs | 5 +---- src/GitHub/Endpoints/Activity/Watching.hs | 5 +---- src/GitHub/Endpoints/Enterprise/Organizations.hs | 5 +---- src/GitHub/Endpoints/Gists.hs | 5 +---- src/GitHub/Endpoints/Gists/Comments.hs | 5 +---- src/GitHub/Endpoints/GitData/Blobs.hs | 5 +---- src/GitHub/Endpoints/GitData/Commits.hs | 5 +---- src/GitHub/Endpoints/GitData/References.hs | 5 +---- src/GitHub/Endpoints/GitData/Trees.hs | 5 +---- src/GitHub/Endpoints/Issues.hs | 6 ++---- src/GitHub/Endpoints/Issues/Comments.hs | 5 +---- src/GitHub/Endpoints/Issues/Events.hs | 5 +---- src/GitHub/Endpoints/Issues/Labels.hs | 5 +---- src/GitHub/Endpoints/Issues/Milestones.hs | 5 +---- src/GitHub/Endpoints/Organizations.hs | 5 +---- src/GitHub/Endpoints/Organizations/Members.hs | 5 +---- src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs | 5 +---- src/GitHub/Endpoints/Organizations/Teams.hs | 5 +---- src/GitHub/Endpoints/PullRequests.hs | 6 +----- src/GitHub/Endpoints/PullRequests/Comments.hs | 5 +---- src/GitHub/Endpoints/PullRequests/Reviews.hs | 5 +---- src/GitHub/Endpoints/RateLimit.hs | 5 +---- src/GitHub/Endpoints/Repos.hs | 5 +---- src/GitHub/Endpoints/Repos/Collaborators.hs | 5 +---- src/GitHub/Endpoints/Repos/Comments.hs | 6 ++---- src/GitHub/Endpoints/Repos/Commits.hs | 6 ++---- src/GitHub/Endpoints/Repos/Contents.hs | 5 +---- src/GitHub/Endpoints/Repos/Forks.hs | 5 +---- src/GitHub/Endpoints/Repos/Invitations.hs | 5 +---- src/GitHub/Endpoints/Repos/Statuses.hs | 5 +---- src/GitHub/Endpoints/Repos/Webhooks.hs | 5 +---- src/GitHub/Endpoints/Search.hs | 5 +---- src/GitHub/Endpoints/Users.hs | 5 +---- src/GitHub/Endpoints/Users/Emails.hs | 5 +---- src/GitHub/Endpoints/Users/Followers.hs | 5 +---- src/GitHub/Enterprise.hs | 6 +----- src/GitHub/Internal/Prelude.hs | 6 ++---- src/GitHub/Request.hs | 6 ++---- 68 files changed, 57 insertions(+), 298 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index da5e9f2b..10e34602 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -1,8 +1,4 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports all request constructors and data definitions from -- this package. -- @@ -16,7 +12,7 @@ -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. --- + module GitHub ( -- * Activity -- | See diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 432b2486..ccc2415a 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Auth ( Auth (..), AuthMethod, diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 6b475d40..4d8748f8 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. + module GitHub.Data ( -- * Tagged types -- ** Name diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index d95d3a25..e03986dc 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Activities where import GitHub.Data.Id (Id, mkId) @@ -107,4 +102,3 @@ instance FromJSON Notification where <*> o .: "updated_at" <*> o .: "last_read_at" <*> o .: "url" - diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index cb52b04b..d4a9194d 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Comments where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 7a4dca9b..d776c2b6 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,10 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Content where import GitHub.Data.GitData diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 0d56171b..73962f28 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Definitions where import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index d27237e5..9ff578b6 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Email where import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Enterprise.hs b/src/GitHub/Data/Enterprise.hs index 125a8d69..dd5b9337 100644 --- a/src/GitHub/Data/Enterprise.hs +++ b/src/GitHub/Data/Enterprise.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports the @GitHub.Data.Enterprise.@ submodules. + module GitHub.Data.Enterprise ( -- * Module re-exports module GitHub.Data.Enterprise.Organizations, diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs index 967cd718..9c48f386 100644 --- a/src/GitHub/Data/Enterprise/Organizations.hs +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Enterprise.Organizations where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index d7b34528..db0e881a 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Events where import GitHub.Data.Definitions @@ -14,6 +9,7 @@ import Prelude () -- /TODO:/ -- -- * missing repo, org, payload, id +-- data Event = Event -- { eventId :: !(Id Event) -- id can be encoded as string. { eventActor :: !SimpleUser diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index b6d1b673..ab2e846d 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Gists where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index fa9973d1..95b47533 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.GitData where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index e0dcfe27..ddbc9e25 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Id ( Id(..), mkId, diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 894ce64f..1ea656f9 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Invitation where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 3ec17781..191b342e 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Issues where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index a8db2864..385678d1 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Milestone where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 35c12b0c..dbc09653 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,9 +1,4 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Name ( Name(..), mkName, diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 5d27e0b1..87c489a7 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -1,10 +1,8 @@ {-# LANGUAGE RecordWildCards #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Module with modifiers for pull requests' and issues' listings. + module GitHub.Data.Options ( -- * Common modifiers stateOpen, diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0075986a..79054b6a 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.PullRequests ( SimplePullRequest(..), PullRequest(..), diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 2ba008f0..2db078af 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.RateLimit where import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 63779d77..98c254c2 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,14 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} #define UNSAFE 1 ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ -- orphan-ish instance for @aeson < 1@ + module GitHub.Data.Repos where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 4180a938..445c4223 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -3,11 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Request ( -- * Request Request, diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index 96b9f2c8..b56067b0 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Search where import GitHub.Data.Repos (CodeSearchRepo) diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 79ef9706..622370ae 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -2,11 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Teams where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 9b29b673..d98703ae 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.URL ( URL(..), getUrl, diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 8ca2fe8e..143d8006 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index a90d4e23..1ea7590b 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Verification of incomming webhook payloads, as described at -- + module GitHub.Data.Webhooks.Validate ( isValidPayload ) where diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs index 8074ab2a..1b0676e9 100644 --- a/src/GitHub/Endpoints/Activity/Events.hs +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The events API as described on . + module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs index 7c246c54..7a900aa7 100644 --- a/src/GitHub/Endpoints/Activity/Notifications.hs +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -1,8 +1,4 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo watching API as described on -- . diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index be589db0..7d77057b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo starring API as described on -- . + module GitHub.Endpoints.Activity.Starring ( stargazersForR, reposStarredByR, diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 92b7829d..3ad5954b 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo watching API as described on -- . + module GitHub.Endpoints.Activity.Watching ( watchersForR, reposWatchedByR, diff --git a/src/GitHub/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs index 589c3d35..1e71334f 100644 --- a/src/GitHub/Endpoints/Enterprise/Organizations.hs +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The GitHub Enterprise orgs API as described on . + module GitHub.Endpoints.Enterprise.Organizations ( createOrganizationR, renameOrganizationR, diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index de8e6c20..da1fc194 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The gists API as described at . + module GitHub.Endpoints.Gists ( gistsR, gistR, diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index d6a127dd..5234a63c 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The loving comments people have left on Gists, described on -- . + module GitHub.Endpoints.Gists.Comments ( commentsOnR, gistCommentR, diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 4c3c5f88..c7b39aea 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- 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 ( blobR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 109ca87d..82a18bf3 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- 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 ( gitCommitR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index bf64657f..a1f10814 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -1,11 +1,8 @@ ------------------------------------------------------------------------------ -- | --- 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 ( referenceR, referencesR, diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 434d8e95..4bdf389b 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- 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 ( treeR, nestedTreeR, diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index f1980dbf..9cd7258f 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The issues API as described on . + module GitHub.Endpoints.Issues ( currentUserIssuesR, organizationIssuesR, diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 18550abc..0c307d3f 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github issue comments API from -- . + module GitHub.Endpoints.Issues.Comments ( commentR, commentsR, diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index e69ed9fa..0639026c 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github issue events API, which is described on -- + module GitHub.Endpoints.Issues.Events ( eventsForIssueR, eventsForRepoR, diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 3d129e8c..bdf2319d 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for dealing with labels on Github issues as described on -- . + module GitHub.Endpoints.Issues.Labels ( labelsOnRepoR, labelR, diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 78b6531d..18d5d9d4 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The milestones API as described on -- . + module GitHub.Endpoints.Issues.Milestones ( milestonesR, milestoneR, diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 12844510..0cb3da47 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The orgs API as described on . + module GitHub.Endpoints.Organizations ( publicOrganizationsForR, publicOrganizationR, diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 26a8f4c4..84e52e43 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The organization members API as described on -- . + module GitHub.Endpoints.Organizations.Members ( membersOfR, membersOfWithR, diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs index 9bc392dd..dee42fcf 100644 --- a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs +++ b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The organization members API as described on -- . + module GitHub.Endpoints.Organizations.OutsideCollaborators ( outsideCollaboratorsR, ) where diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 189e68f7..af8c8b36 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Owner teams API as described on -- . + module GitHub.Endpoints.Organizations.Teams ( teamsOfR, teamInfoForR, diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 7217e51b..5e5d6aac 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The pull requests API as documented at -- . + module GitHub.Endpoints.PullRequests ( pullRequestsForR, pullRequestR, @@ -102,4 +99,3 @@ mergePullRequestR user repo prid commitMessage = 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 index 9bb6fca2..e1117921 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The pull request review comments API as described at -- . + module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsR, pullRequestCommentR, diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index fe95d25b..e746e570 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The reviews API as described on . + module GitHub.Endpoints.PullRequests.Reviews ( pullRequestReviewsR , pullRequestReviewR diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs index 3bbe8c2f..8d559613 100644 --- a/src/GitHub/Endpoints/RateLimit.hs +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github RateLimit API, as described at -- . + module GitHub.Endpoints.RateLimit ( rateLimitR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index b8c9d79d..85c8b639 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Repos API, as documented at -- + module GitHub.Endpoints.Repos ( -- * Querying repositories currentUserReposR, diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 5322b36d..f587636d 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo collaborators API as described on -- . + module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOnR, collaboratorPermissionOnR, diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 2b853c0e..371288e3 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo commits API as described on -- . + module GitHub.Endpoints.Repos.Comments ( commentsForR, commitCommentsForR, diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index bfe0cc84..3a10e0a9 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo commits API as described on -- . + module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), commitsForR, diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 55f48c99..00d2c632 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Repo Contents API, as documented at -- + module GitHub.Endpoints.Repos.Contents ( -- * Querying contents contentsForR, diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index f556e1f8..c9b56e30 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Hot forking action, as described at -- . + module GitHub.Endpoints.Repos.Forks ( forksForR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/Repos/Invitations.hs b/src/GitHub/Endpoints/Repos/Invitations.hs index 68239961..066c7abc 100644 --- a/src/GitHub/Endpoints/Repos/Invitations.hs +++ b/src/GitHub/Endpoints/Repos/Invitations.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo invitations API as described on -- . + module GitHub.Endpoints.Repos.Invitations ( listInvitationsOnR, listInvitationsForR, diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index 1c1f167d..93c4682f 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo statuses API as described on -- . + module GitHub.Endpoints.Repos.Statuses ( createStatusR, statusesForR, diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 8b828f30..402fb4af 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,11 +1,8 @@ - ----------------------------------------------------------------------------- -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The webhooks API, as described at -- -- + module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories webhooksForR, diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 36b8c414..06ddd373 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Search API, as described at -- . + module GitHub.Endpoints.Search( searchReposR, searchCodeR, diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index ef68bba6..85f5e68e 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Users API, as described at -- . + module GitHub.Endpoints.Users ( userInfoForR, ownerInfoForR, diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs index 9ba76389..c9e42520 100644 --- a/src/GitHub/Endpoints/Users/Emails.hs +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The user emails API as described on -- . + module GitHub.Endpoints.Users.Emails ( currentUserEmailsR, currentUserPublicEmailsR, diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index db58900f..13f8b494 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The user followers API as described on -- . + module GitHub.Endpoints.Users.Followers ( usersFollowingR, usersFollowedByR, diff --git a/src/GitHub/Enterprise.hs b/src/GitHub/Enterprise.hs index bb64b7d7..d9474cd6 100644 --- a/src/GitHub/Enterprise.hs +++ b/src/GitHub/Enterprise.hs @@ -1,11 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports all request constructors and data definitions for -- working with GitHub Enterprise. --- + module GitHub.Enterprise ( -- * Enterprise Admin -- | See diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 1994abac..23eab9d0 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,11 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module may change between minor releases. Do not rely on its contents. + module GitHub.Internal.Prelude ( module Prelude.Compat, -- * Commonly used types diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 2481deea..c5eb006c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -6,11 +6,8 @@ {-# 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. @@ -30,6 +27,7 @@ -- > -- | Lift request into Monad -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton + module GitHub.Request ( -- * A convenient execution of requests github, From 08b16f77a2d84186f39d8f56b1beeffcccf30eaa Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 17:01:18 +0200 Subject: [PATCH 277/309] More .gitignores --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index 452bddc6..93ce2741 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,8 @@ .env dist dist-newstyle +/dist* +/tmp .ghc.environment.* *swp .cabal-sandbox @@ -10,7 +12,9 @@ cabal.sandbox.config *~ *.hi *.o +*.lock .stack-work run.sh src/hightlight.js src/style.css +TAGS From 69404f728e4351b8c8ebcf4206ac945cb11129a3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 17:47:57 +0200 Subject: [PATCH 278/309] GitHub.Internal.Prelude: simplify export list (remove duplication) --- src/GitHub/Internal/Prelude.hs | 73 +++++++++++----------------------- 1 file changed, 23 insertions(+), 50 deletions(-) diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 23eab9d0..0419d934 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -4,56 +4,29 @@ -- | -- This module may change between minor releases. Do not rely on its contents. -module GitHub.Internal.Prelude ( - module Prelude.Compat, - -- * Commonly used types - UTCTime, - HashMap, - Text, pack, unpack, - Vector, - -- * Commonly used typeclasses - Binary, - Data, Typeable, - Generic, - Hashable(..), - IsString(..), - NFData(..), genericRnf, - Semigroup(..), - -- * Aeson - FromJSON(..), ToJSON(..), Value(..), Object, - emptyObject, - encode, - withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, - -- * Control.Applicative - (<|>), - -- * Data.Maybe - catMaybes, - -- * Data.List - intercalate, toList, - -- * Data.Time.ISO8601 - formatISO8601, - ) where +module GitHub.Internal.Prelude ( module X ) where -import Control.Applicative ((<|>)) -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson +import Control.Applicative as X ((<|>)) +import Control.DeepSeq as X (NFData (..)) +import Control.DeepSeq.Generics as X (genericRnf) +import Data.Aeson as X (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (emptyObject, typeMismatch) -import Data.Binary (Binary) -import Data.Binary.Instances () -import Data.Data (Data, Typeable) -import Data.Foldable (toList) -import Data.Hashable (Hashable (..)) -import Data.HashMap.Strict (HashMap) -import Data.List (intercalate) -import Data.Maybe (catMaybes) -import Data.Semigroup (Semigroup (..)) -import Data.String (IsString (..)) -import Data.Text (Text, pack, unpack) -import Data.Time.Compat (UTCTime) -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) -import GHC.Generics (Generic) -import Prelude.Compat +import Data.Aeson.Types as X (emptyObject, typeMismatch) +import Data.Binary as X (Binary) +import Data.Binary.Instances as X () +import Data.Data as X (Data, Typeable) +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.Compat 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 ((<&>)) From 5a26a8cfbfe4f00ceaf3a51d06a43d33cb39085e Mon Sep 17 00:00:00 2001 From: Oleg Nykolyn Date: Fri, 23 Jun 2023 22:46:03 -0700 Subject: [PATCH 279/309] Implement Actions API. (#459) New data structures and endpoints to access the GitHub Actions API. Commit squashed from the following commits: * Implement actions->artifacts API. * Up * Cleanup * Actions - cache. * Actions - artifacts and cache. * Secrets * Workflows. * WorkflowJobs. * WorkflowRuns. * Format * Artifacts QA. * Cache QA. * Secrets QA. * WorkflowJobs QA. * Workflows QA. * Format. * Drop slack-related files. * Format JSON * Support workflow name in workflowRunsForWorkflowR. * Support workflow name in Workflows.hs. * Fix * Fix * Do not parse pull requests from workflow runs. * Avoid parsing 'trigerring_actor', it is sometimes missing. * Fix workflow run conclusion parsing. * Whitespace and lexical changes only * Remove outdated maintainer from module headers * Whitespace: align code * Bump cabal-version to 2.4 for globbing * Cosmetics: use (<&>) * Restore upper bounds for openssl etc. in .cabal file * Whitespace * Add haddocks for WithTotalCount * Changelog for PR #459 --------- Co-authored-by: Andreas Abel --- .gitignore | 2 + CHANGELOG.md | 8 +- fixtures/actions/artifact.json | 19 + fixtures/actions/artifacts-list.json | 43 ++ fixtures/actions/cache-list.json | 14 + fixtures/actions/org-cache-usage.json | 4 + fixtures/actions/org-public-key.json | 4 + fixtures/actions/org-secrets-list.json | 18 + fixtures/actions/repo-cache-usage.json | 5 + .../selected-repositories-for-secret.json | 72 ++ fixtures/actions/workflow-job.json | 113 +++ fixtures/actions/workflow-list.json | 17 + fixtures/actions/workflow-runs-list.json | 665 ++++++++++++++++++ github.cabal | 32 +- spec/GitHub/Actions/ArtifactsSpec.hs | 66 ++ spec/GitHub/Actions/CacheSpec.hs | 53 ++ spec/GitHub/Actions/SecretsSpec.hs | 50 ++ spec/GitHub/Actions/WorkflowJobSpec.hs | 32 + spec/GitHub/Actions/WorkflowRunsSpec.hs | 32 + spec/GitHub/Actions/WorkflowSpec.hs | 32 + src/GitHub.hs | 76 ++ src/GitHub/Data.hs | 14 + src/GitHub/Data/Actions/Artifacts.hs | 76 ++ src/GitHub/Data/Actions/Cache.hs | 78 ++ src/GitHub/Data/Actions/Common.hs | 33 + src/GitHub/Data/Actions/Secrets.hs | 141 ++++ src/GitHub/Data/Actions/WorkflowJobs.hs | 98 +++ src/GitHub/Data/Actions/WorkflowRuns.hs | 91 +++ src/GitHub/Data/Actions/Workflows.hs | 62 ++ src/GitHub/Data/Options.hs | 271 +++++++ src/GitHub/Endpoints/Actions/Artifacts.hs | 61 ++ src/GitHub/Endpoints/Actions/Cache.hs | 66 ++ src/GitHub/Endpoints/Actions/Secrets.hs | 221 ++++++ src/GitHub/Endpoints/Actions/WorkflowJobs.hs | 58 ++ src/GitHub/Endpoints/Actions/WorkflowRuns.hs | 181 +++++ src/GitHub/Endpoints/Actions/Workflows.hs | 68 ++ 36 files changed, 2870 insertions(+), 6 deletions(-) create mode 100644 fixtures/actions/artifact.json create mode 100644 fixtures/actions/artifacts-list.json create mode 100644 fixtures/actions/cache-list.json create mode 100644 fixtures/actions/org-cache-usage.json create mode 100644 fixtures/actions/org-public-key.json create mode 100644 fixtures/actions/org-secrets-list.json create mode 100644 fixtures/actions/repo-cache-usage.json create mode 100644 fixtures/actions/selected-repositories-for-secret.json create mode 100644 fixtures/actions/workflow-job.json create mode 100644 fixtures/actions/workflow-list.json create mode 100644 fixtures/actions/workflow-runs-list.json create mode 100644 spec/GitHub/Actions/ArtifactsSpec.hs create mode 100644 spec/GitHub/Actions/CacheSpec.hs create mode 100644 spec/GitHub/Actions/SecretsSpec.hs create mode 100644 spec/GitHub/Actions/WorkflowJobSpec.hs create mode 100644 spec/GitHub/Actions/WorkflowRunsSpec.hs create mode 100644 spec/GitHub/Actions/WorkflowSpec.hs create mode 100644 src/GitHub/Data/Actions/Artifacts.hs create mode 100644 src/GitHub/Data/Actions/Cache.hs create mode 100644 src/GitHub/Data/Actions/Common.hs create mode 100644 src/GitHub/Data/Actions/Secrets.hs create mode 100644 src/GitHub/Data/Actions/WorkflowJobs.hs create mode 100644 src/GitHub/Data/Actions/WorkflowRuns.hs create mode 100644 src/GitHub/Data/Actions/Workflows.hs create mode 100644 src/GitHub/Endpoints/Actions/Artifacts.hs create mode 100644 src/GitHub/Endpoints/Actions/Cache.hs create mode 100644 src/GitHub/Endpoints/Actions/Secrets.hs create mode 100644 src/GitHub/Endpoints/Actions/WorkflowJobs.hs create mode 100644 src/GitHub/Endpoints/Actions/WorkflowRuns.hs create mode 100644 src/GitHub/Endpoints/Actions/Workflows.hs diff --git a/.gitignore b/.gitignore index 93ce2741..3a8f6f25 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,5 @@ run.sh src/hightlight.js src/style.css TAGS +.DS_Store + diff --git a/CHANGELOG.md b/CHANGELOG.md index 1fa91d95..0926cfee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ ## Changes for 0.29 -_2022-06-24, Andreas Abel, Midsommar edition_ +_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` 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/github.cabal b/github.cabal index a0669042..5f94c430 100644 --- a/github.cabal +++ b/github.cabal @@ -1,4 +1,4 @@ -cabal-version: >=1.10 +cabal-version: 2.4 name: github version: 0.29 synopsis: Access to the GitHub API, v3. @@ -20,7 +20,7 @@ description: . For more of an overview please see the README: -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus maintainer: Andreas Abel @@ -43,10 +43,12 @@ tested-with: GHC == 7.10.3 GHC == 7.8.4 -extra-source-files: +extra-doc-files: README.md CHANGELOG.md - fixtures/*.json + +extra-source-files: + fixtures/**/*.json source-repository head type: git @@ -89,6 +91,13 @@ library 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 @@ -120,6 +129,12 @@ library 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 @@ -165,7 +180,8 @@ library GitHub.Internal.Prelude GitHub.Request - other-modules: Paths_github + other-modules: Paths_github + autogen-modules: Paths_github -- Packages bundles with GHC, mtl and text are also here build-depends: @@ -222,6 +238,12 @@ test-suite github-test build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.12 other-extensions: TemplateHaskell other-modules: + GitHub.Actions.ArtifactsSpec + GitHub.Actions.CacheSpec + GitHub.Actions.SecretsSpec + GitHub.Actions.WorkflowJobSpec + GitHub.Actions.WorkflowRunsSpec + GitHub.Actions.WorkflowSpec GitHub.ActivitySpec GitHub.CommitsSpec GitHub.EventsSpec 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/src/GitHub.hs b/src/GitHub.hs index 10e34602..c3a3d88f 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -409,6 +409,76 @@ module GitHub ( -- | 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 @@ -416,6 +486,12 @@ 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 diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 4d8748f8..20ebe7fd 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -32,6 +32,13 @@ module GitHub.Data ( 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, @@ -65,6 +72,13 @@ 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 diff --git a/src/GitHub/Data/Actions/Artifacts.hs b/src/GitHub/Data/Actions/Artifacts.hs new file mode 100644 index 00000000..7b572d2b --- /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, Typeable, 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, Typeable, 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..a4f65a60 --- /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, Typeable, Eq, Ord, Generic) + +data RepositoryCacheUsage = RepositoryCacheUsage + { repositoryCacheUsageFullName :: !Text + , repositoryCacheUsageActiveCachesSizeInBytes :: !Int + , repositoryCacheUsageActiveCachesCount :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data OrganizationCacheUsage = OrganizationCacheUsage + { organizationCacheUsageTotalActiveCachesSizeInBytes :: !Int + , organizationCacheUsageTotalActiveCachesCount :: !Int + } + deriving (Show, Data, Typeable, 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..ed02b6f0 --- /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, Typeable, 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..c734ad89 --- /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, Typeable, Eq, Ord, Generic) + +data PublicKey = PublicKey + { publicKeyId :: !Text + , publicKeyKey :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SetSecret = SetSecret + { setSecretPublicKeyId :: !Text + , setSecretEncryptedValue :: !Text + , setSecretVisibility :: !Text + , setSecretSelectedRepositoryIds :: !(Maybe [Id Repo]) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SetRepoSecret = SetRepoSecret + { setRepoSecretPublicKeyId :: !Text + , setRepoSecretEncryptedValue :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SelectedRepo = SelectedRepo + { selectedRepoRepoId :: !(Id Repo) + , selectedRepoRepoName :: !(Name Repo) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SetSelectedRepositories = SetSelectedRepositories + { setSelectedRepositoriesRepositoryIds :: ![Id Repo] + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data RepoSecret = RepoSecret + { repoSecretName :: !(Name RepoSecret) + , repoSecretCreatedAt :: !UTCTime + , repoSecretUpdatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +-- TODO move somewhere else? +data Environment = Environment + deriving (Show, Data, Typeable, 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..9698e3a9 --- /dev/null +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -0,0 +1,98 @@ +{-# 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, Typeable, 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, Typeable, 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 + , jobSteps :: !(Vector JobStep) + , jobRunCheckUrl :: !URL + , jobLabels :: !(Vector Text) + , jobRunnerId :: !Integer + , jobRunnerName :: !Text + , jobRunnerGroupId :: !Integer + , jobRunnerGroupName :: !Text + } + deriving (Show, Data, Typeable, 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 .: "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..3dae581b --- /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, Typeable, Eq, Ord, Generic) + +data RunAttempt = RunAttempt + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data ReviewHistory = ReviewHistory + { reviewHistoryState :: !Text + , reviewHistoryComment :: !Text + , reviewHistoryUser :: !SimpleUser + + } + deriving (Show, Data, Typeable, 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..9dd2252d --- /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, Typeable, Eq, Ord, Generic) + +data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent + { createWorkflowDispatchEventRef :: !Text + , createWorkflowDispatchEventInputs :: !a + } + deriving (Show, Generic) + +instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) where rnf = genericRnf +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/Options.hs b/src/GitHub/Data/Options.hs index 87c489a7..f1ce58da 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} -- | -- Module with modifiers for pull requests' and issues' listings. @@ -46,6 +47,31 @@ module GitHub.Data.Options ( 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 (..), @@ -207,6 +233,18 @@ data FilterBy a deriving (Eq, Ord, Show, Generic, Typeable, Data) +-- Actions cache + +data SortCache + = SortCacheCreatedAt + | SortCacheLastAccessedAt + | SortCacheSizeInBytes + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortCache where rnf = genericRnf +instance Binary SortCache + ------------------------------------------------------------------------------- -- Classes ------------------------------------------------------------------------------- @@ -663,3 +701,236 @@ optionsNoAssignee = IssueRepoMod $ \opts -> 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, Typeable, 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, Typeable, 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, Typeable, 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/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 From f701d4108eb9f68277ccba9b2a9dade443899ae3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 27 Jun 2023 22:45:06 +0200 Subject: [PATCH 280/309] v0.29 revision 1: allow aeson-2.2 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 5f94c430..e8dd34aa 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 +x-revision: 1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -197,7 +198,7 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.2 + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.3 , base-compat >=0.11.1 && <0.14 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 From d94e93a7aa0f5345b510be4b7949420cd7879eb5 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 16 Jul 2023 20:27:39 +0200 Subject: [PATCH 281/309] v0.29 revision 2: allow bytestring-0.12 --- github.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/github.cabal b/github.cabal index e8dd34aa..6c3b1d76 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 1 +x-revision: 2 synopsis: Access to the GitHub API, v3. category: Network description: @@ -188,7 +188,7 @@ library build-depends: base >=4.7 && <5 , binary >=0.7.1.0 && <0.11 - , bytestring >=0.10.4.0 && <0.12 + , bytestring >=0.10.4.0 && <0.13 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 From 7ba08645b601195c227c4b2491fc2b84549364ab Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 3 Aug 2023 12:13:44 +0200 Subject: [PATCH 282/309] v0.29-r3: allow deepseq-1.5 for GHC 9.8 --- github.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/github.cabal b/github.cabal index 6c3b1d76..69b1ffbf 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 2 +x-revision: 3 synopsis: Access to the GitHub API, v3. category: Network description: @@ -190,7 +190,8 @@ library , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 , containers >=0.5.5.1 && <0.7 - , deepseq >=1.3.0.2 && <1.5 + , deepseq >=1.3.0.2 && <1.6 + , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 , text >=1.2.0.6 && <2.1 , time-compat >=1.9.2.2 && <1.10 @@ -204,7 +205,6 @@ library , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 - , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.5 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 From c0ce867ce3fc8368173f8698a67e533924b97f75 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Sep 2023 12:59:19 +0200 Subject: [PATCH 283/309] v0.29-r4: allow containers-0.7 and text-2.1 The former is also tested by a constraint-set in CI. (The latter cannot atm because of aeson's incompatibility with text-2.1.) --- .github/workflows/haskell-ci.yml | 72 ++++++++++++++++++++++---------- cabal.haskell-ci | 13 +++++- github.cabal | 12 +++--- samples/github-samples.cabal | 5 ++- 4 files changed, 70 insertions(+), 32 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b5d24eb9..64853c33 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -6,22 +6,20 @@ # # haskell-ci regenerate # -# For more information, see https://github.com/haskell-CI/haskell-ci +# For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.16.4 +# version: 0.17.20230928 # -# REGENDATA ("0.16.4",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.17.20230928",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: push: branches: - master - - ci* pull_request: branches: - master - - ci* jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} @@ -29,19 +27,24 @@ jobs: timeout-minutes: 60 container: - image: buildpack-deps:bionic + image: buildpack-deps:focal continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.6.2 + - compiler: ghc-9.8.0.20230919 compilerKind: ghc - compilerVersion: 9.6.2 + compilerVersion: 9.8.0.20230919 + setup-method: ghcup + allow-failure: true + - compiler: ghc-9.6.3 + compilerKind: ghc + compilerVersion: 9.6.3 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.5 + - compiler: ghc-9.4.7 compilerKind: ghc - compilerVersion: 9.4.5 + compilerVersion: 9.4.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.2.8 @@ -89,11 +92,6 @@ jobs: compilerVersion: 7.10.3 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-7.8.4 - compilerKind: ghc - compilerVersion: 7.8.4 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt @@ -102,8 +100,9 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else @@ -111,8 +110,9 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: @@ -127,10 +127,12 @@ jobs: echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER if [ "${{ matrix.setup-method }}" = ghcup ]; then - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + 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=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND @@ -144,7 +146,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90800)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -173,6 +175,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -273,6 +291,16 @@ jobs: run: | rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: prepare for constraint sets + run: | + rm -f cabal.project.local + - name: constraint set containers-0.7 + run: | + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all --dry-run ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then cabal-plan topo | sort ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' --dependencies-only -j2 all ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - name: save cache uses: actions/cache/save@v3 if: always() diff --git a/cabal.haskell-ci b/cabal.haskell-ci index a3ce9738..6c697b60 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,4 +1,4 @@ -branches: master ci* +branches: master haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any @@ -10,4 +10,13 @@ jobs-selection: any -- constraint-set text-2.0 -- constraints: text >= 2.0 --- allow-newer: *:text -- allow-newer not supported \ No newline at end of file +-- 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/github.cabal b/github.cabal index 69b1ffbf..225c6c17 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 3 +x-revision: 4 synopsis: Access to the GitHub API, v3. category: Network description: @@ -31,8 +31,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.6.2 - GHC == 9.4.5 + GHC == 9.8.0 + GHC == 9.6.3 + GHC == 9.4.7 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 @@ -42,7 +43,6 @@ tested-with: GHC == 8.2.2 GHC == 8.0.2 GHC == 7.10.3 - GHC == 7.8.4 extra-doc-files: README.md @@ -189,11 +189,11 @@ library base >=4.7 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 - , containers >=0.5.5.1 && <0.7 + , containers >=0.5.5.1 && <0.8 , deepseq >=1.3.0.2 && <1.6 , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 - , text >=1.2.0.6 && <2.1 + , text >=1.2.0.6 && <2.2 , time-compat >=1.9.2.2 && <1.10 , transformers >=0.3.0.0 && <0.7 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c3c6813d..3686dcfd 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.6.2 - GHC == 9.4.5 + GHC == 9.8.0 + GHC == 9.6.3 + GHC == 9.4.7 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 From 6b9716c1d397248aa8394d04b386fe763053dcdd Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 17 Oct 2023 09:29:06 +0200 Subject: [PATCH 284/309] Bump Haskell-CI to GHC 9.8.1 --- .github/workflows/haskell-ci.yml | 39 ++++++++++---------------------- github.cabal | 2 +- samples/github-samples.cabal | 2 +- 3 files changed, 14 insertions(+), 29 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 64853c33..5574ac10 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.17.20230928 +# version: 0.17.20231012 # -# REGENDATA ("0.17.20230928",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.17.20231012",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,11 +32,11 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.8.0.20230919 + - compiler: ghc-9.8.1 compilerKind: ghc - compilerVersion: 9.8.0.20230919 + compilerVersion: 9.8.1 setup-method: ghcup - allow-failure: true + allow-failure: false - compiler: ghc-9.6.3 compilerKind: ghc compilerVersion: 9.6.3 @@ -65,27 +65,27 @@ jobs: - compiler: ghc-8.8.4 compilerKind: ghc compilerVersion: 8.8.4 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.6.5 compilerKind: ghc compilerVersion: 8.6.5 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.4.4 compilerKind: ghc compilerVersion: 8.4.4 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.2.2 compilerKind: ghc compilerVersion: 8.2.2 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.0.2 compilerKind: ghc compilerVersion: 8.0.2 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-7.10.3 compilerKind: ghc @@ -97,7 +97,7 @@ jobs: - name: apt run: | apt-get update - apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" @@ -146,7 +146,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 90800)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -175,18 +175,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 225c6c17..cde8b8ff 100644 --- a/github.cabal +++ b/github.cabal @@ -31,7 +31,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.8.0 + GHC == 9.8.1 GHC == 9.6.3 GHC == 9.4.7 GHC == 9.2.8 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 3686dcfd..166a0ce0 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,7 +10,7 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.8.0 + GHC == 9.8.1 GHC == 9.6.3 GHC == 9.4.7 GHC == 9.2.8 From ee8b28628552efa230d6a194d2f342e7305e56f8 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 24 May 2024 00:05:53 +0200 Subject: [PATCH 285/309] Allow base-compat<1, hashable<2, bump CI to GHC 9.10.1 --- .github/workflows/haskell-ci.yml | 88 +++++++++++--------------------- github.cabal | 18 ++++--- samples/github-samples.cabal | 7 +-- 3 files changed, 45 insertions(+), 68 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 5574ac10..738964dc 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.17.20231012 +# version: 0.19.20240703 # -# REGENDATA ("0.17.20231012",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20240703",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -27,24 +27,29 @@ jobs: timeout-minutes: 60 container: - image: buildpack-deps:focal + image: buildpack-deps:jammy continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.8.1 + - compiler: ghc-9.10.1 compilerKind: ghc - compilerVersion: 9.8.1 + compilerVersion: 9.10.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.6.3 + - compiler: ghc-9.8.2 compilerKind: ghc - compilerVersion: 9.6.3 + compilerVersion: 9.8.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.7 + - compiler: ghc-9.6.6 compilerKind: ghc - compilerVersion: 9.4.7 + compilerVersion: 9.6.6 + 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 @@ -82,39 +87,17 @@ jobs: compilerVersion: 8.2.2 setup-method: ghcup allow-failure: false - - compiler: ghc-8.0.2 - compilerKind: ghc - compilerVersion: 8.0.2 - setup-method: ghcup - allow-failure: false - - compiler: ghc-7.10.3 - compilerKind: ghc - compilerVersion: 7.10.3 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev - if [ "${{ matrix.setup-method }}" = ghcup ]; then - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - else - apt-add-repository -y 'ppa:hvr/ghc' - apt-get update - apt-get install -y "$HCNAME" - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - fi + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -126,22 +109,13 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - if [ "${{ matrix.setup-method }}" = ghcup ]; then - 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" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - else - HC=$HCDIR/bin/$HCKIND - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" - echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - fi - + 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" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$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" @@ -226,8 +200,8 @@ jobs: touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + echo "package github" >> cabal.project + echo " ghc-options: -Werror=missing-methods" >> 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" >> cabal.project ; fi cat >> cabal.project <> cabal.project.local + $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 @@ -245,7 +219,7 @@ jobs: $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - name: restore cache - uses: actions/cache/restore@v3 + uses: actions/cache/restore@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -287,7 +261,7 @@ jobs: if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - name: save cache - uses: actions/cache/save@v3 + uses: actions/cache/save@v4 if: always() with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} diff --git a/github.cabal b/github.cabal index cde8b8ff..eb835470 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 4 +x-revision: 5 synopsis: Access to the GitHub API, v3. category: Network description: @@ -31,9 +31,10 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.8.1 - GHC == 9.6.3 - GHC == 9.4.7 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 @@ -41,8 +42,9 @@ tested-with: GHC == 8.6.5 GHC == 8.4.4 GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 + -- Build failure of HsOpenSSL with GHC 8.0 + -- https://github.com/haskell-cryptography/HsOpenSSL/issues/97 + -- GHC == 8.0.2 extra-doc-files: README.md @@ -200,12 +202,12 @@ library -- other packages build-depends: aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.3 - , base-compat >=0.11.1 && <0.14 + , 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 , deepseq-generics >=0.2.0.0 && <0.3 - , hashable >=1.2.7.0 && <1.5 + , 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 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 166a0ce0..ced03e5e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,9 +10,10 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.8.1 - GHC == 9.6.3 - GHC == 9.4.7 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 From 415e4748bf5d38434ae143a3520d3bc6d5c27cdf Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 17 Oct 2024 22:28:09 +0200 Subject: [PATCH 286/309] Drop support for GHC 8.0 and below --- CHANGELOG.md | 7 +++++++ github.cabal | 21 ++++++--------------- samples/Operational/Operational.hs | 2 +- src/GitHub/Data.hs | 2 -- src/GitHub/Data/Name.hs | 5 ----- src/GitHub/Data/RateLimit.hs | 2 +- src/GitHub/Data/Repos.hs | 22 ---------------------- src/GitHub/Data/Request.hs | 1 - src/GitHub/Endpoints/Issues.hs | 2 -- src/GitHub/Endpoints/Repos/Comments.hs | 2 -- src/GitHub/Endpoints/Repos/Commits.hs | 2 -- src/GitHub/Internal/Prelude.hs | 3 +-- 12 files changed, 16 insertions(+), 55 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0926cfee..e090d021 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## Changes for 0.29.1 + +- Drop support for GHC 8.0 and below. +- Drop dependency `time-compat`. + +Tested with GHC 8.2 - 9.10.1. + ## Changes for 0.29 _2023-06-24, Andreas Abel, Midsommar edition_ diff --git a/github.cabal b/github.cabal index eb835470..d4d2d930 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,6 @@ cabal-version: 2.4 name: github -version: 0.29 -x-revision: 5 +version: 0.29.1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -42,9 +41,6 @@ tested-with: GHC == 8.6.5 GHC == 8.4.4 GHC == 8.2.2 - -- Build failure of HsOpenSSL with GHC 8.0 - -- https://github.com/haskell-cryptography/HsOpenSSL/issues/97 - -- GHC == 8.0.2 extra-doc-files: README.md @@ -66,11 +62,9 @@ library default-language: Haskell2010 ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: - -Wcompat - -Wno-star-is-type - -- The star-is-type warning cannot be sensiblity addressed while supporting GHC 7. + -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 @@ -188,7 +182,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <5 + base >=4.10 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 , containers >=0.5.5.1 && <0.8 @@ -196,7 +190,7 @@ library , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 , text >=1.2.0.6 && <2.2 - , time-compat >=1.9.2.2 && <1.10 + , time >=1.8.0.2 && <2 , transformers >=0.3.0.0 && <0.7 -- other packages @@ -229,9 +223,6 @@ library http-client-tls >=0.3.5.3 && <0.4 , tls >=1.4.1 - if !impl(ghc >=8.0) - build-depends: semigroups >=0.18.5 && <0.20 - test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index cbfc9fb4..1fc7f897 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} + module Main (main) where import Common diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 20ebe7fd..740c6837 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index dbc09653..99554287 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module GitHub.Data.Name ( Name(..), mkName, @@ -8,10 +7,8 @@ module GitHub.Data.Name ( import Prelude () import GitHub.Internal.Prelude -#if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) -#endif newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -38,7 +35,6 @@ instance ToJSON (Name entity) where instance IsString (Name entity) where fromString = N . fromString -#if MIN_VERSION_aeson(1,0,0) -- | @since 0.15.0.0 instance ToJSONKey (Name entity) where toJSONKey = toJSONKeyText untagName @@ -46,4 +42,3 @@ instance ToJSONKey (Name entity) where -- | @since 0.15.0.0 instance FromJSONKey (Name entity) where fromJSONKey = fromJSONKeyCoerce -#endif diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 2db078af..4e0b549c 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -3,7 +3,7 @@ module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () -import Data.Time.Clock.System.Compat (SystemTime (..)) +import Data.Time.Clock.System (SystemTime (..)) import qualified Data.ByteString.Char8 as BS8 import qualified Network.HTTP.Client as HTTP diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 98c254c2..456775b6 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} -#define UNSAFE 1 -- | -- This module also exports @@ -19,13 +17,7 @@ import Prelude () import qualified Data.HashMap.Strict as HM import qualified Data.Text as T -#if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) -#else -#ifdef UNSAFE -import Unsafe.Coerce (unsafeCoerce) -#endif -#endif data Repo = Repo { repoId :: !(Id Repo) @@ -383,22 +375,8 @@ instance FromJSON Language where instance ToJSON Language where toJSON = toJSON . getLanguage -#if MIN_VERSION_aeson(1,0,0) instance FromJSONKey Language where fromJSONKey = fromJSONKeyCoerce -#else -instance FromJSON a => FromJSON (HM.HashMap Language a) where - parseJSON = fmap mapKeyLanguage . parseJSON - where - mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a -#ifdef UNSAFE - mapKeyLanguage = unsafeCoerce -#else - mapKeyLanguage = mapKey Language - mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a - mapKey f = HM.fromList . map (first f) . HM.toList -#endif -#endif data ArchiveFormat = ArchiveFormatTarball -- ^ ".tar.gz" format diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 445c4223..7b4eac40 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 9cd7258f..47888dc5 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- The issues API as described on . diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 371288e3..bd554492 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- The repo commits API as described on -- . diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 3a10e0a9..1c50c651 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- The repo commits API as described on -- . diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 0419d934..d6efaf39 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE CPP #-} -- | -- This module may change between minor releases. Do not rely on its contents. @@ -24,7 +23,7 @@ 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.Compat as X (UTCTime) +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) From a71ddecb90f091349827a6aea8a856ea5bb11bc3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Mon, 11 Nov 2024 17:42:45 +0100 Subject: [PATCH 287/309] Bump CI to GHC 9.12.1 --- .github/workflows/haskell-ci.yml | 73 +++++++++++++++++++------------- cabal.haskell-ci | 14 +++--- github.cabal | 3 +- samples/github-samples.cabal | 7 +-- 4 files changed, 57 insertions(+), 40 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 738964dc..ea643e3f 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.19.20240703 +# version: 0.19.20241219 # -# REGENDATA ("0.19.20240703",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20241219",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,14 +32,19 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.12.1 + compilerKind: ghc + compilerVersion: 9.12.1 + setup-method: ghcup + allow-failure: false - compiler: ghc-9.10.1 compilerKind: ghc compilerVersion: 9.10.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.8.2 + - compiler: ghc-9.8.4 compilerKind: ghc - compilerVersion: 9.8.2 + compilerVersion: 9.8.4 setup-method: ghcup allow-failure: false - compiler: ghc-9.6.6 @@ -89,15 +94,30 @@ jobs: allow-failure: false fail-fast: false steps: - - name: apt + - 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.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + - name: Install cabal-install (prerelease) + run: | + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; + "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -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) - "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (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 }} @@ -108,21 +128,12 @@ jobs: echo "LANG=C.UTF-8" >> "$GITHUB_ENV" echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" - HCDIR=/opt/$HCKIND/$HCVER - 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" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$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" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" - echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -149,6 +160,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> 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 @@ -250,19 +275,9 @@ jobs: run: | rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - - name: prepare for constraint sets - run: | - rm -f cabal.project.local - - name: constraint set containers-0.7 - run: | - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all --dry-run ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then cabal-plan topo | sort ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' --dependencies-only -j2 all ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - name: save cache - uses: actions/cache/save@v4 if: always() + uses: actions/cache/save@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store diff --git a/cabal.haskell-ci b/cabal.haskell-ci index 6c697b60..ccddf4a2 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -12,11 +12,11 @@ jobs-selection: any -- 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 +-- constraint-set containers-0.7 +-- ghc: >= 9 +-- constraints: containers >= 0.7 +-- tests: True +-- run-tests: True -raw-project - allow-newer: containers +-- raw-project +-- allow-newer: containers diff --git a/github.cabal b/github.cabal index d4d2d930..8ac29dbb 100644 --- a/github.cabal +++ b/github.cabal @@ -30,8 +30,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: + GHC == 9.12.1 GHC == 9.10.1 - GHC == 9.8.2 + GHC == 9.8.4 GHC == 9.6.6 GHC == 9.4.8 GHC == 9.2.8 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index ced03e5e..8ed82b07 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: + GHC == 9.12.1 GHC == 9.10.1 - GHC == 9.8.2 + GHC == 9.8.4 GHC == 9.6.6 GHC == 9.4.8 GHC == 9.2.8 @@ -40,7 +41,7 @@ executable github-operational hs-source-dirs: Operational ghc-options: -Wall -threaded build-depends: - , base >=0 && <5 + , base , base-compat-batteries , github , github-samples @@ -56,7 +57,7 @@ common deps -Wall -threaded build-depends: - , base >=4.8 && <5 + , base , base-compat-batteries , base64-bytestring , github From e11917be3f6dc647afe2ca39e9ec1fea7867c49d Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 27 Mar 2025 17:49:01 +0100 Subject: [PATCH 288/309] Allow containers<1, bump CI to GHC 9.12.2 --- .github/workflows/haskell-ci.yml | 42 ++++++++++---------------------- github.cabal | 6 ++--- samples/github-samples.cabal | 4 +-- 3 files changed, 18 insertions(+), 34 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index ea643e3f..d007d9bf 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -6,11 +6,11 @@ # # haskell-ci regenerate # -# For more information, see https://github.com/andreasabel/haskell-ci +# For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20241219 +# version: 0.19.20250327 # -# REGENDATA ("0.19.20241219",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20250327",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -23,7 +23,7 @@ on: jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} - runs-on: ubuntu-20.04 + runs-on: ubuntu-24.04 timeout-minutes: 60 container: @@ -32,9 +32,9 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.12.1 + - compiler: ghc-9.12.2 compilerKind: ghc - compilerVersion: 9.12.1 + compilerVersion: 9.12.2 setup-method: ghcup allow-failure: false - compiler: ghc-9.10.1 @@ -47,9 +47,9 @@ jobs: compilerVersion: 9.8.4 setup-method: ghcup allow-failure: false - - compiler: ghc-9.6.6 + - compiler: ghc-9.6.7 compilerKind: ghc - compilerVersion: 9.6.6 + compilerVersion: 9.6.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.4.8 @@ -101,13 +101,12 @@ jobs: - name: Install GHCup run: | mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" + 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 (prerelease) + - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; - "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -vnormal+nowrap" >> "$GITHUB_ENV" + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - name: Install GHC (GHCup) if: matrix.setup-method == 'ghcup' run: | @@ -132,7 +131,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} @@ -160,18 +159,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> 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 diff --git a/github.cabal b/github.cabal index 8ac29dbb..044051fb 100644 --- a/github.cabal +++ b/github.cabal @@ -30,10 +30,10 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.12.1 + GHC == 9.12.2 GHC == 9.10.1 GHC == 9.8.4 - GHC == 9.6.6 + GHC == 9.6.7 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 @@ -186,7 +186,7 @@ library base >=4.10 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 - , containers >=0.5.5.1 && <0.8 + , containers >=0.5.5.1 && <1 , deepseq >=1.3.0.2 && <1.6 , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 8ed82b07..cb9ca075 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,10 +10,10 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.12.1 + GHC == 9.12.2 GHC == 9.10.1 GHC == 9.8.4 - GHC == 9.6.6 + GHC == 9.6.7 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 From 00fd2a376985da1f7769c683e0e15857a8481000 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 11:13:10 +0200 Subject: [PATCH 289/309] Bump CI to GHC 9.10.2 --- .github/workflows/haskell-ci.yml | 13 +++++++------ github.cabal | 2 +- samples/github-samples.cabal | 2 +- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index d007d9bf..bb4e2c16 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20250327 +# version: 0.19.20250506 # -# REGENDATA ("0.19.20250327",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20250506",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -37,9 +37,9 @@ jobs: compilerVersion: 9.12.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.10.1 + - compiler: ghc-9.10.2 compilerKind: ghc - compilerVersion: 9.10.1 + compilerVersion: 9.10.2 setup-method: ghcup allow-failure: false - compiler: ghc-9.8.4 @@ -105,8 +105,8 @@ jobs: chmod a+x "$HOME/.ghcup/bin/ghcup" - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" - name: Install GHC (GHCup) if: matrix.setup-method == 'ghcup' run: | @@ -217,6 +217,7 @@ jobs: cat >> cabal.project < Date: Sat, 18 Jan 2025 14:40:12 +1100 Subject: [PATCH 290/309] add missing name field --- src/GitHub/Data/Actions/WorkflowJobs.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Data/Actions/WorkflowJobs.hs b/src/GitHub/Data/Actions/WorkflowJobs.hs index 9698e3a9..05f28861 100644 --- a/src/GitHub/Data/Actions/WorkflowJobs.hs +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -47,6 +47,7 @@ data Job = Job , jobConclusion :: !Text , jobStartedAt :: !UTCTime , jobCompletedAt :: !UTCTime + , jobName :: !(Name Job) , jobSteps :: !(Vector JobStep) , jobRunCheckUrl :: !URL , jobLabels :: !(Vector Text) @@ -84,6 +85,7 @@ instance FromJSON Job where <*> o .: "conclusion" <*> o .: "started_at" <*> o .: "completed_at" + <*> o .: "name" <*> o .: "steps" <*> o .: "check_run_url" <*> o .: "labels" From 3b24f4126272344ba7138013bdb2396addb0077f Mon Sep 17 00:00:00 2001 From: Magnus Therning Date: Sat, 9 Mar 2024 15:11:12 +0100 Subject: [PATCH 291/309] Make the subject URL optional This goes against the documentation at https://docs.github.com/en/rest/activity/notifications but it seems to be required in order to handle certain types of notifications. --- src/GitHub/Data/Activities.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index e03986dc..850b7445 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -26,7 +26,7 @@ instance FromJSON RepoStarred where data Subject = Subject { subjectTitle :: !Text - , subjectURL :: !URL + , subjectURL :: !(Maybe URL) , subjectLatestCommentURL :: !(Maybe URL) -- https://developer.github.com/v3/activity/notifications/ doesn't indicate -- what the possible values for this field are. From 709cc3abb3d3b33f5305b4d299b5b2c1a173c8e7 Mon Sep 17 00:00:00 2001 From: maralorn Date: Tue, 24 Sep 2024 23:37:17 +0200 Subject: [PATCH 292/309] Add new Notification reasons --- src/GitHub/Data/Activities.hs | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 850b7445..540241c8 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -46,13 +46,18 @@ instance FromJSON Subject where <*> o .: "type" data NotificationReason - = AssignReason + = ApprovalRequestedReason + | AssignReason | AuthorReason | CommentReason + | CiActivityReason | InvitationReason | ManualReason + | MemberFeatureRequestedReason | MentionReason | ReviewRequestedReason + | SecurityAlertReason + | SecurityAdvisoryCreditReason | StateChangeReason | SubscribedReason | TeamMentionReason @@ -63,17 +68,22 @@ instance Binary NotificationReason instance FromJSON NotificationReason where parseJSON = withText "NotificationReason" $ \t -> case T.toLower t of - "assign" -> pure AssignReason - "author" -> pure AuthorReason - "comment" -> pure CommentReason - "invitation" -> pure InvitationReason - "manual" -> pure ManualReason - "mention" -> pure MentionReason - "review_requested" -> pure ReviewRequestedReason - "state_change" -> pure StateChangeReason - "subscribed" -> pure SubscribedReason - "team_mention" -> pure TeamMentionReason - _ -> fail $ "Unknown NotificationReason " ++ show t + "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 From 529e3578ce88fb3ec84ab531fbb6ad5788f8d6e0 Mon Sep 17 00:00:00 2001 From: Daan Rijks Date: Wed, 11 Sep 2024 13:55:17 +0200 Subject: [PATCH 293/309] Add initial subset of Reactions endpoints --- github.cabal | 2 + src/GitHub.hs | 10 ++++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Reactions.hs | 78 +++++++++++++++++++++++++++++++ src/GitHub/Endpoints/Reactions.hs | 60 ++++++++++++++++++++++++ 5 files changed, 152 insertions(+) create mode 100644 src/GitHub/Data/Reactions.hs create mode 100644 src/GitHub/Endpoints/Reactions.hs diff --git a/github.cabal b/github.cabal index 55a825e8..f9e8e8db 100644 --- a/github.cabal +++ b/github.cabal @@ -117,6 +117,7 @@ library GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests GitHub.Data.RateLimit + GitHub.Data.Reactions GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request @@ -157,6 +158,7 @@ library 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 diff --git a/src/GitHub.hs b/src/GitHub.hs index c3a3d88f..309cb1db 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -285,6 +285,15 @@ module GitHub ( commitR, diffR, + -- ** Reactions + -- | See + issueReactionsR, + createIssueReactionR, + deleteIssueReactionR, + commentReactionsR, + createCommentReactionR, + deleteCommentReactionR, + -- ** Contents -- | See contentsForR, @@ -514,6 +523,7 @@ import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.PullRequests.Reviews +import GitHub.Endpoints.Reactions import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 740c6837..18fb770d 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -55,6 +55,7 @@ module GitHub.Data ( 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, @@ -97,6 +98,7 @@ 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 diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs new file mode 100644 index 00000000..f5fc3ead --- /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, Typeable, Eq, Ord, Generic) + +instance NFData Reaction where rnf = genericRnf +instance Binary Reaction + +data NewReaction = NewReaction + { newReactionContent :: !ReactionContent + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewReaction where rnf = genericRnf +instance Binary NewReaction + +-- | +-- +data ReactionContent + = PlusOne + | MinusOne + | Laugh + | Confused + | Heart + | Hooray + | Rocket + | Eyes + deriving (Show, Data, Typeable, Eq, Ord, Enum, Bounded, Generic) + +instance NFData ReactionContent where rnf = genericRnf +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/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] From 2bed394e451f77fca85942f6421b4968fcc0e0c4 Mon Sep 17 00:00:00 2001 From: Tom McLaughlin Date: Fri, 9 May 2025 08:13:45 -0700 Subject: [PATCH 294/309] Support pagination (#503) * Working on PerPageQuery * Add issuesForRepoPagedR + failing test * Testing, todo REVERT * About to try integrating paging into the normal executeRequest calls * API is looking better, call this v2 * Clean up some debugging stuff * More cleanup * More cleanup * Another slight refactor * Another cleanup * Improve test --- github.cabal | 1 + spec/GitHub/IssuesSpec.hs | 32 ++++++++++++++++---- src/GitHub/Data/Request.hs | 39 +++++++++++++++++++++++- src/GitHub/Request.hs | 62 ++++++++++++++++++++++++++++++-------- 4 files changed, 115 insertions(+), 19 deletions(-) diff --git a/github.cabal b/github.cabal index f9e8e8db..e97f8b41 100644 --- a/github.cabal +++ b/github.cabal @@ -264,6 +264,7 @@ test-suite github-test , file-embed , github , hspec >=2.6.1 && <2.12 + , http-client , tagged , text , unordered-containers diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 2a7f5e7b..e673975f 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,12 +6,13 @@ import qualified GitHub import Prelude () import Prelude.Compat -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import System.Environment (lookupEnv) -import Test.Hspec - (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) +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 @@ -38,6 +39,25 @@ spec = 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 $ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 7b4eac40..c8138c1a 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -14,6 +14,8 @@ module GitHub.Data.Request ( CommandMethod(..), toMethod, FetchCount(..), + PageParams(..), + PageLinks(..), MediaType (..), Paths, IsPathPart(..), @@ -29,6 +31,7 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) ------------------------------------------------------------------------------ -- Path parts @@ -74,7 +77,10 @@ toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. -data FetchCount = FetchAtLeast !Word | FetchAll +data FetchCount = + FetchAtLeast !Word + | FetchAll + | FetchPage PageParams deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -96,6 +102,37 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf +------------------------------------------------------------------------------- +-- 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, Typeable) + +instance Hashable PageParams +instance Binary PageParams +instance NFData PageParams where rnf = genericRnf + +------------------------------------------------------------------------------- +-- 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, Typeable) + +instance NFData PageLinks where rnf = genericRnf + ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index c5eb006c..332d1124 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -54,6 +54,7 @@ module GitHub.Request ( ParseResponse (..), makeHttpRequest, parseStatus, + parsePageLinks, StatusMap, getNextUrl, performPagedRequest, @@ -79,6 +80,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Maybe (fromMaybe) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -87,13 +89,14 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) +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 @@ -199,11 +202,6 @@ executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req -lessFetchCount :: Int -> FetchCount -> Bool -lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j - - -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -235,10 +233,13 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do res <- httpLbs' httpReq (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) - where - predicate v = lessFetchCount (length v) l + 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 @@ -456,7 +457,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -464,7 +465,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -496,6 +497,14 @@ makeHttpRequest auth r = case r of setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } + extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] + extraQueryItems = case r of + PagedQuery _ _ (FetchPage pp) -> catMaybes [ + (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + ] + _ -> [] + -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do @@ -542,6 +551,35 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do go (acc <> m) res' req' (_, _) -> return (acc <$ res) +-- | Helper for requesting a single page, as specified by 'PageParams'. +-- +-- This parses and returns the 'PageLinks' alongside the HTTP response. +performPerPageRequest + :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a, PageLinks)) +performPerPageRequest httpLbs' initReq = Tagged $ do + res <- httpLbs' initReq + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) + return (m <$ res, parsePageLinks res) + +-- | Parse the 'PageLinks' from an HTTP response, where the information is +-- encoded in the Link header. +parsePageLinks :: HTTP.Response a -> PageLinks +parsePageLinks res = PageLinks { + pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links + , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links + , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links + , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links + } + where + links :: [Link URI] + links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) + + linkToUri :: Link URI -> URI + linkToUri (Link uri _) = uri + ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- From 63a4e0cc3a2393789a6a4b489f344991b1b8a499 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Sun, 16 Jul 2023 08:42:29 +0200 Subject: [PATCH 295/309] Allow JWT as an authentication method, fixes #489 --- src/GitHub/Auth.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index ccc2415a..2b41dbf4 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,5 +1,7 @@ module GitHub.Auth ( Auth (..), + Token, + JWTToken, AuthMethod, endpoint, setAuthRequest @@ -9,14 +11,17 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString +type JWTToken = Text -- | The Github auth data type data Auth = BasicAuth BS.ByteString BS.ByteString -- ^ Username and password | OAuth Token -- ^ OAuth token + | JWT JWTToken -- ^ JWT Token | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -40,10 +45,12 @@ instance AuthMethod () where 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 From dc438164bfc7b152074fdb58e1d3d18e86820777 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:23:18 +0200 Subject: [PATCH 296/309] Revert "Support pagination (#503)" This reverts commit 2bed394e451f77fca85942f6421b4968fcc0e0c4. --- github.cabal | 1 - spec/GitHub/IssuesSpec.hs | 32 ++++---------------- src/GitHub/Data/Request.hs | 39 +----------------------- src/GitHub/Request.hs | 62 ++++++++------------------------------ 4 files changed, 19 insertions(+), 115 deletions(-) diff --git a/github.cabal b/github.cabal index e97f8b41..f9e8e8db 100644 --- a/github.cabal +++ b/github.cabal @@ -264,7 +264,6 @@ test-suite github-test , file-embed , github , hspec >=2.6.1 && <2.12 - , http-client , tagged , text , unordered-containers diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index e673975f..2a7f5e7b 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,13 +6,12 @@ import qualified GitHub import Prelude () import Prelude.Compat -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import Network.HTTP.Client (newManager, responseBody) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) - +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -39,25 +38,6 @@ spec = 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 $ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c8138c1a..7b4eac40 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -14,8 +14,6 @@ module GitHub.Data.Request ( CommandMethod(..), toMethod, FetchCount(..), - PageParams(..), - PageLinks(..), MediaType (..), Paths, IsPathPart(..), @@ -31,7 +29,6 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method -import Network.URI (URI) ------------------------------------------------------------------------------ -- Path parts @@ -77,10 +74,7 @@ toMethod Delete = Method.methodDelete -- | '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 +data FetchCount = FetchAtLeast !Word | FetchAll deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -102,37 +96,6 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf -------------------------------------------------------------------------------- --- 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, Typeable) - -instance Hashable PageParams -instance Binary PageParams -instance NFData PageParams where rnf = genericRnf - -------------------------------------------------------------------------------- --- 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, Typeable) - -instance NFData PageLinks where rnf = genericRnf - ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 332d1124..c5eb006c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -54,7 +54,6 @@ module GitHub.Request ( ParseResponse (..), makeHttpRequest, parseStatus, - parsePageLinks, StatusMap, getNextUrl, performPagedRequest, @@ -80,7 +79,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) -import Data.Maybe (fromMaybe) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -89,14 +87,13 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (Link(..), LinkParam (..), href, linkParams) +import Network.HTTP.Link.Types (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 @@ -202,6 +199,11 @@ executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req +lessFetchCount :: Int -> FetchCount -> Bool +lessFetchCount _ FetchAll = True +lessFetchCount i (FetchAtLeast j) = i < fromIntegral j + + -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -233,13 +235,10 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ 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 (PagedQuery _ _ l) = + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + where + predicate v = lessFetchCount (length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq @@ -457,7 +456,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString (qs <> extraQueryItems) + . setQueryString qs $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -465,7 +464,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString (qs <> extraQueryItems) + . setQueryString qs $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -497,14 +496,6 @@ makeHttpRequest auth r = case r of setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } - extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] - extraQueryItems = case r of - PagedQuery _ _ (FetchPage pp) -> catMaybes [ - (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp - , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp - ] - _ -> [] - -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do @@ -551,35 +542,6 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do go (acc <> m) res' req' (_, _) -> return (acc <$ res) --- | Helper for requesting a single page, as specified by 'PageParams'. --- --- This parses and returns the 'PageLinks' alongside the HTTP response. -performPerPageRequest - :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) - => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> HTTP.Request -- ^ initial request - -> Tagged mt (m (HTTP.Response a, PageLinks)) -performPerPageRequest httpLbs' initReq = Tagged $ do - res <- httpLbs' initReq - m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) - return (m <$ res, parsePageLinks res) - --- | Parse the 'PageLinks' from an HTTP response, where the information is --- encoded in the Link header. -parsePageLinks :: HTTP.Response a -> PageLinks -parsePageLinks res = PageLinks { - pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links - , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links - , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links - , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links - } - where - links :: [Link URI] - links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) - - linkToUri :: Link URI -> URI - linkToUri (Link uri _) = uri - ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- From 953b7519b588841c3ae7fd6235ad4fd72dbfdf0b Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 12:07:46 +0200 Subject: [PATCH 297/309] Bump to 0.30, fix #520 --- github.cabal | 2 +- src/GitHub/Data/Options.hs | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index f9e8e8db..2c6bccf0 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: github -version: 0.29.1 +version: 0.30 synopsis: Access to the GitHub API, v3. category: Network description: diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index f1ce58da..bf03c617 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -122,6 +122,7 @@ instance Binary IssueState -- | 'GitHub.Data.Issues.Issue' state reason data IssueStateReason = StateReasonCompleted + | StateReasonDuplicate | StateReasonNotPlanned | StateReasonReopened deriving @@ -130,12 +131,14 @@ data IssueStateReason 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 From a76cec17bdcda100bc58114fb7c5037a1034cf1a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:31:29 +0200 Subject: [PATCH 298/309] cabal.project: pass use-pkg-config flag to HsOpenSSL --- cabal.project | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal.project b/cabal.project index ed0996f6..be4081d6 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ tests: True constraints: github +openssl constraints: github-samples +openssl +constraints: HsOpenSSL +use-pkg-config constraints: operational -buildExamples -- constraints: text >=2 From 854aa2138bba952503420e08cda8c5ab3733f81a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:29:28 +0200 Subject: [PATCH 299/309] Revert "Revert "Support pagination (#503)"" This reverts commit dc438164bfc7b152074fdb58e1d3d18e86820777. --- github.cabal | 1 + spec/GitHub/IssuesSpec.hs | 32 ++++++++++++++++---- src/GitHub/Data/Request.hs | 39 +++++++++++++++++++++++- src/GitHub/Request.hs | 62 ++++++++++++++++++++++++++++++-------- 4 files changed, 115 insertions(+), 19 deletions(-) diff --git a/github.cabal b/github.cabal index 2c6bccf0..517468bc 100644 --- a/github.cabal +++ b/github.cabal @@ -264,6 +264,7 @@ test-suite github-test , file-embed , github , hspec >=2.6.1 && <2.12 + , http-client , tagged , text , unordered-containers diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 2a7f5e7b..e673975f 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,12 +6,13 @@ import qualified GitHub import Prelude () import Prelude.Compat -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import System.Environment (lookupEnv) -import Test.Hspec - (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) +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 @@ -38,6 +39,25 @@ spec = 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 $ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 7b4eac40..c8138c1a 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -14,6 +14,8 @@ module GitHub.Data.Request ( CommandMethod(..), toMethod, FetchCount(..), + PageParams(..), + PageLinks(..), MediaType (..), Paths, IsPathPart(..), @@ -29,6 +31,7 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) ------------------------------------------------------------------------------ -- Path parts @@ -74,7 +77,10 @@ toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. -data FetchCount = FetchAtLeast !Word | FetchAll +data FetchCount = + FetchAtLeast !Word + | FetchAll + | FetchPage PageParams deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -96,6 +102,37 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf +------------------------------------------------------------------------------- +-- 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, Typeable) + +instance Hashable PageParams +instance Binary PageParams +instance NFData PageParams where rnf = genericRnf + +------------------------------------------------------------------------------- +-- 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, Typeable) + +instance NFData PageLinks where rnf = genericRnf + ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index c5eb006c..332d1124 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -54,6 +54,7 @@ module GitHub.Request ( ParseResponse (..), makeHttpRequest, parseStatus, + parsePageLinks, StatusMap, getNextUrl, performPagedRequest, @@ -79,6 +80,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Maybe (fromMaybe) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -87,13 +89,14 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) +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 @@ -199,11 +202,6 @@ executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req -lessFetchCount :: Int -> FetchCount -> Bool -lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j - - -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -235,10 +233,13 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do res <- httpLbs' httpReq (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) - where - predicate v = lessFetchCount (length v) l + 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 @@ -456,7 +457,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -464,7 +465,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -496,6 +497,14 @@ makeHttpRequest auth r = case r of setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } + extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] + extraQueryItems = case r of + PagedQuery _ _ (FetchPage pp) -> catMaybes [ + (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + ] + _ -> [] + -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do @@ -542,6 +551,35 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do go (acc <> m) res' req' (_, _) -> return (acc <$ res) +-- | Helper for requesting a single page, as specified by 'PageParams'. +-- +-- This parses and returns the 'PageLinks' alongside the HTTP response. +performPerPageRequest + :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a, PageLinks)) +performPerPageRequest httpLbs' initReq = Tagged $ do + res <- httpLbs' initReq + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) + return (m <$ res, parsePageLinks res) + +-- | Parse the 'PageLinks' from an HTTP response, where the information is +-- encoded in the Link header. +parsePageLinks :: HTTP.Response a -> PageLinks +parsePageLinks res = PageLinks { + pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links + , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links + , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links + , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links + } + where + links :: [Link URI] + links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) + + linkToUri :: Link URI -> URI + linkToUri (Link uri _) = uri + ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- From c54e7d65fad497c9d2e492ee9ea2c9e5650c2d71 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:39:55 +0200 Subject: [PATCH 300/309] Fix compilation with bytestring<11 --- src/GitHub/Request.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 332d1124..39deb0a6 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -500,8 +500,8 @@ makeHttpRequest auth r = case r of extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] extraQueryItems = case r of PagedQuery _ _ (FetchPage pp) -> catMaybes [ - (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp - , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + (\page -> ("page", Just (LBS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (LBS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp ] _ -> [] From affa80fba86af0086cc6665675fd008cd0c06702 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Fri, 9 Sep 2022 10:59:33 +0100 Subject: [PATCH 301/309] Implement organization membership endpoint --- src/GitHub.hs | 1 + src/GitHub/Data/Definitions.hs | 57 +++++++++++++++++++ src/GitHub/Endpoints/Organizations/Members.hs | 8 +++ 3 files changed, 66 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index 309cb1db..5d323de8 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -173,6 +173,7 @@ module GitHub ( membersOfWithR, isMemberOfR, orgInvitationsR, + orgMembershipR, -- ** Outside Collaborators -- | See -- diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 73962f28..456974f7 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -233,6 +233,63 @@ 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, Typeable, Data) + +instance NFData MembershipRole where rnf = genericRnf +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, Typeable, Eq, Ord, Generic) + +instance NFData MembershipState where rnf = genericRnf +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, Typeable, Eq, Ord, Generic) + +instance NFData Membership where rnf = genericRnf +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 ------------------------------------------------------------------------------- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 84e52e43..8de82b77 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -7,6 +7,7 @@ module GitHub.Endpoints.Organizations.Members ( membersOfWithR, isMemberOfR, orgInvitationsR, + orgMembershipR, module GitHub.Data, ) where @@ -48,3 +49,10 @@ isMemberOfR user org = -- 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 From 78e136d0936dd1430a5d2d366bf743b893d939b3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 18:10:20 +0200 Subject: [PATCH 302/309] Changelog for 0.30 --- CHANGELOG.md | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e090d021..45c00f5a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,19 @@ -## Changes for 0.29.1 +## 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.10.1. +Tested with GHC 8.2 - 9.12.2. + ## Changes for 0.29 From 7076a46da978683e16f5617e666eb0e6fe3a3b21 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:34:25 +0200 Subject: [PATCH 303/309] Drop obsolete dependency on deepseq-generics Functionality is available from deepseq --- github.cabal | 1 - src/GitHub/Auth.hs | 2 +- src/GitHub/Data/Actions/Workflows.hs | 2 +- src/GitHub/Data/Activities.hs | 8 +++--- src/GitHub/Data/Comments.hs | 10 +++---- src/GitHub/Data/Content.hs | 22 +++++++-------- src/GitHub/Data/Definitions.hs | 24 ++++++++--------- src/GitHub/Data/Deployments.hs | 12 ++++----- src/GitHub/Data/Email.hs | 4 +-- src/GitHub/Data/Enterprise/Organizations.hs | 6 ++--- src/GitHub/Data/Events.hs | 2 +- src/GitHub/Data/Gists.hs | 10 +++---- src/GitHub/Data/GitData.hs | 30 ++++++++++----------- src/GitHub/Data/Invitation.hs | 6 ++--- src/GitHub/Data/Issues.hs | 12 ++++----- src/GitHub/Data/Milestone.hs | 6 ++--- src/GitHub/Data/Options.hs | 16 +++++------ src/GitHub/Data/PullRequests.hs | 18 ++++++------- src/GitHub/Data/RateLimit.hs | 4 +-- src/GitHub/Data/Reactions.hs | 6 ++--- src/GitHub/Data/Releases.hs | 4 +-- src/GitHub/Data/Repos.hs | 20 +++++++------- src/GitHub/Data/Request.hs | 6 ++--- src/GitHub/Data/Reviews.hs | 12 +++------ src/GitHub/Data/Search.hs | 4 +-- src/GitHub/Data/Statuses.hs | 4 +-- src/GitHub/Data/Teams.hs | 20 +++++++------- src/GitHub/Data/URL.hs | 2 +- src/GitHub/Data/Webhooks.hs | 12 ++++----- src/GitHub/Internal/Prelude.hs | 1 - 30 files changed, 139 insertions(+), 147 deletions(-) diff --git a/github.cabal b/github.cabal index 517468bc..b9843588 100644 --- a/github.cabal +++ b/github.cabal @@ -203,7 +203,6 @@ library , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 - , deepseq-generics >=0.2.0.0 && <0.3 , hashable >=1.2.7.0 && <2 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 2b41dbf4..1800808f 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -25,7 +25,7 @@ data Auth | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Auth where rnf = genericRnf +instance NFData Auth instance Binary Auth instance Hashable Auth diff --git a/src/GitHub/Data/Actions/Workflows.hs b/src/GitHub/Data/Actions/Workflows.hs index 9dd2252d..ae36ddbf 100644 --- a/src/GitHub/Data/Actions/Workflows.hs +++ b/src/GitHub/Data/Actions/Workflows.hs @@ -33,7 +33,7 @@ data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent } deriving (Show, Generic) -instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) where rnf = genericRnf +instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) instance (Binary a) => Binary (CreateWorkflowDispatchEvent a) ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 540241c8..70e356cf 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -15,7 +15,7 @@ data RepoStarred = RepoStarred } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoStarred where rnf = genericRnf +instance NFData RepoStarred instance Binary RepoStarred -- JSON Instances @@ -35,7 +35,7 @@ data Subject = Subject } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Subject where rnf = genericRnf +instance NFData Subject instance Binary Subject instance FromJSON Subject where @@ -63,7 +63,7 @@ data NotificationReason | TeamMentionReason deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData NotificationReason where rnf = genericRnf +instance NFData NotificationReason instance Binary NotificationReason instance FromJSON NotificationReason where @@ -99,7 +99,7 @@ data Notification = Notification } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Notification where rnf = genericRnf +instance NFData Notification instance Binary Notification instance FromJSON Notification where diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index d4a9194d..0084cd9b 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -21,7 +21,7 @@ data Comment = Comment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Comment where rnf = genericRnf +instance NFData Comment instance Binary Comment instance FromJSON Comment where @@ -43,7 +43,7 @@ data NewComment = NewComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewComment where rnf = genericRnf +instance NFData NewComment instance Binary NewComment instance ToJSON NewComment where @@ -54,7 +54,7 @@ data EditComment = EditComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditComment where rnf = genericRnf +instance NFData EditComment instance Binary EditComment instance ToJSON EditComment where @@ -68,7 +68,7 @@ data NewPullComment = NewPullComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewPullComment where rnf = genericRnf +instance NFData NewPullComment instance Binary NewPullComment instance ToJSON NewPullComment where @@ -84,7 +84,7 @@ data PullCommentReply = PullCommentReply } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullCommentReply where rnf = genericRnf +instance NFData PullCommentReply instance ToJSON PullCommentReply where toJSON (PullCommentReply b) = diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index d776c2b6..2ac55039 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -20,7 +20,7 @@ data Content | ContentDirectory !(Vector ContentItem) deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Content where rnf = genericRnf +instance NFData Content instance Binary Content data ContentFileData = ContentFileData { @@ -30,7 +30,7 @@ data ContentFileData = ContentFileData { ,contentFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentFileData where rnf = genericRnf +instance NFData ContentFileData instance Binary ContentFileData -- | An item in a directory listing. @@ -39,13 +39,13 @@ data ContentItem = ContentItem { ,contentItemInfo :: !ContentInfo } deriving (Show, Data, Typeable, 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) -instance NFData ContentItemType where rnf = genericRnf +instance NFData ContentItemType instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. @@ -58,7 +58,7 @@ data ContentInfo = ContentInfo { ,contentHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentInfo where rnf = genericRnf +instance NFData ContentInfo instance Binary ContentInfo data ContentResultInfo = ContentResultInfo @@ -66,7 +66,7 @@ data ContentResultInfo = ContentResultInfo , contentResultSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentResultInfo where rnf = genericRnf +instance NFData ContentResultInfo instance Binary ContentResultInfo data ContentResult = ContentResult @@ -74,7 +74,7 @@ data ContentResult = ContentResult , contentResultCommit :: !GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentResult where rnf = genericRnf +instance NFData ContentResult instance Binary ContentResult data Author = Author @@ -83,7 +83,7 @@ data Author = Author } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData Author where rnf = genericRnf +instance NFData Author instance Binary Author data CreateFile = CreateFile @@ -96,7 +96,7 @@ data CreateFile = CreateFile } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData CreateFile where rnf = genericRnf +instance NFData CreateFile instance Binary CreateFile data UpdateFile = UpdateFile @@ -110,7 +110,7 @@ data UpdateFile = UpdateFile } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData UpdateFile where rnf = genericRnf +instance NFData UpdateFile instance Binary UpdateFile data DeleteFile = DeleteFile @@ -123,7 +123,7 @@ data DeleteFile = DeleteFile } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData DeleteFile where rnf = genericRnf +instance NFData DeleteFile instance Binary DeleteFile instance FromJSON Content where diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 456974f7..060c4bec 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -41,7 +41,7 @@ data SimpleUser = SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleUser where rnf = genericRnf +instance NFData SimpleUser instance Binary SimpleUser data SimpleOrganization = SimpleOrganization @@ -52,7 +52,7 @@ data SimpleOrganization = SimpleOrganization } deriving (Show, Data, Typeable, 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' @@ -65,7 +65,7 @@ data SimpleOwner = SimpleOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleOwner where rnf = genericRnf +instance NFData SimpleOwner instance Binary SimpleOwner data User = User @@ -90,7 +90,7 @@ data User = User } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData User where rnf = genericRnf +instance NFData User instance Binary User data Organization = Organization @@ -113,14 +113,14 @@ data Organization = Organization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Organization where rnf = genericRnf +instance NFData Organization instance Binary Organization -- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Owner where rnf = genericRnf +instance NFData Owner instance Binary Owner fromOwner :: Owner -> Either User Organization @@ -242,7 +242,7 @@ data MembershipRole deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData MembershipRole where rnf = genericRnf +instance NFData MembershipRole instance Binary MembershipRole instance FromJSON MembershipRole where @@ -257,7 +257,7 @@ data MembershipState | MembershipActive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData MembershipState where rnf = genericRnf +instance NFData MembershipState instance Binary MembershipState instance FromJSON MembershipState where @@ -277,7 +277,7 @@ data Membership = Membership } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Membership where rnf = genericRnf +instance NFData Membership instance Binary Membership instance FromJSON Membership where @@ -324,7 +324,7 @@ data IssueLabel = IssueLabel } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueLabel where rnf = genericRnf +instance NFData IssueLabel instance Binary IssueLabel instance FromJSON IssueLabel where @@ -346,7 +346,7 @@ data NewIssueLabel = NewIssueLabel } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewIssueLabel where rnf = genericRnf +instance NFData NewIssueLabel instance Binary NewIssueLabel @@ -373,7 +373,7 @@ data UpdateIssueLabel = UpdateIssueLabel } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData UpdateIssueLabel where rnf = genericRnf +instance NFData UpdateIssueLabel instance Binary UpdateIssueLabel diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index e14a214e..b8ba2df0 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -36,7 +36,7 @@ data DeploymentQueryOption | DeploymentQueryEnvironment !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DeploymentQueryOption where rnf = genericRnf +instance NFData DeploymentQueryOption instance Binary DeploymentQueryOption renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) @@ -63,7 +63,7 @@ data Deployment a = Deployment , deploymentRepositoryUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData a => NFData (Deployment a) where rnf = genericRnf +instance NFData a => NFData (Deployment a) instance Binary a => Binary (Deployment a) instance FromJSON a => FromJSON (Deployment a) where @@ -106,7 +106,7 @@ data CreateDeployment a = CreateDeployment -- ^ Short description of the deployment. Default: "" } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData a => NFData (CreateDeployment a) where rnf = genericRnf +instance NFData a => NFData (CreateDeployment a) instance Binary a => Binary (CreateDeployment a) instance ToJSON a => ToJSON (CreateDeployment a) where @@ -134,7 +134,7 @@ data DeploymentStatus = DeploymentStatus , deploymentStatusRepositoryUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DeploymentStatus where rnf = genericRnf +instance NFData DeploymentStatus instance Binary DeploymentStatus instance FromJSON DeploymentStatus where @@ -159,7 +159,7 @@ data DeploymentStatusState | DeploymentStatusInactive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DeploymentStatusState where rnf = genericRnf +instance NFData DeploymentStatusState instance Binary DeploymentStatusState instance ToJSON DeploymentStatusState where @@ -192,7 +192,7 @@ data CreateDeploymentStatus = CreateDeploymentStatus -- Default: "" } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateDeploymentStatus where rnf = genericRnf +instance NFData CreateDeploymentStatus instance Binary CreateDeploymentStatus instance ToJSON CreateDeploymentStatus where diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index 9ff578b6..6e151760 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -10,7 +10,7 @@ data EmailVisibility | EmailVisibilityPublic deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData EmailVisibility where rnf = genericRnf +instance NFData EmailVisibility instance Binary EmailVisibility instance FromJSON EmailVisibility where @@ -26,7 +26,7 @@ data Email = Email , emailVisibility :: !(Maybe EmailVisibility) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Email where rnf = genericRnf +instance NFData Email instance Binary Email instance FromJSON Email where diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs index 9c48f386..29f179af 100644 --- a/src/GitHub/Data/Enterprise/Organizations.hs +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -13,7 +13,7 @@ data CreateOrganization = CreateOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateOrganization where rnf = genericRnf +instance NFData CreateOrganization instance Binary CreateOrganization data RenameOrganization = RenameOrganization @@ -21,7 +21,7 @@ data RenameOrganization = RenameOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RenameOrganization where rnf = genericRnf +instance NFData RenameOrganization instance Binary RenameOrganization data RenameOrganizationResponse = RenameOrganizationResponse @@ -30,7 +30,7 @@ data RenameOrganizationResponse = RenameOrganizationResponse } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RenameOrganizationResponse where rnf = genericRnf +instance NFData RenameOrganizationResponse instance Binary RenameOrganizationResponse -- JSON Instances diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index db0e881a..16b85eca 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -18,7 +18,7 @@ data Event = Event } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Event where rnf = genericRnf +instance NFData Event instance Binary Event instance FromJSON Event where diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index ab2e846d..7e46c686 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -23,7 +23,7 @@ data Gist = Gist , gistGitPullUrl :: !URL } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData Gist where rnf = genericRnf +instance NFData Gist instance Binary Gist instance FromJSON Gist where @@ -51,7 +51,7 @@ data GistFile = GistFile } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData GistFile where rnf = genericRnf +instance NFData GistFile instance Binary GistFile instance FromJSON GistFile where @@ -73,7 +73,7 @@ data GistComment = GistComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GistComment where rnf = genericRnf +instance NFData GistComment instance Binary GistComment instance FromJSON GistComment where @@ -91,7 +91,7 @@ data NewGist = NewGist , newGistPublic :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData NewGist where rnf = genericRnf +instance NFData NewGist instance Binary NewGist instance ToJSON NewGist where @@ -111,7 +111,7 @@ data NewGistFile = NewGistFile { newGistFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData NewGistFile where rnf = genericRnf +instance NFData NewGistFile instance Binary NewGistFile instance ToJSON NewGistFile where diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 95b47533..d4fd8798 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -24,7 +24,7 @@ data Stats = Stats } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Stats where rnf = genericRnf +instance NFData Stats instance Binary Stats data Commit = Commit @@ -39,7 +39,7 @@ data Commit = Commit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Commit where rnf = genericRnf +instance NFData Commit instance Binary Commit data Tree = Tree @@ -49,7 +49,7 @@ data Tree = Tree } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Tree where rnf = genericRnf +instance NFData Tree instance Binary Tree data GitTree = GitTree @@ -63,7 +63,7 @@ data GitTree = GitTree } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitTree where rnf = genericRnf +instance NFData GitTree instance Binary GitTree data GitCommit = GitCommit @@ -77,7 +77,7 @@ data GitCommit = GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitCommit where rnf = genericRnf +instance NFData GitCommit instance Binary GitCommit data Blob = Blob @@ -89,7 +89,7 @@ data Blob = Blob } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Blob where rnf = genericRnf +instance NFData Blob instance Binary Blob data Tag = Tag @@ -100,7 +100,7 @@ data Tag = Tag } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Tag where rnf = genericRnf +instance NFData Tag instance Binary Tag data Branch = Branch @@ -109,7 +109,7 @@ data Branch = Branch } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Branch where rnf = genericRnf +instance NFData Branch data BranchCommit = BranchCommit { branchCommitSha :: !Text @@ -117,7 +117,7 @@ data BranchCommit = BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData BranchCommit where rnf = genericRnf +instance NFData BranchCommit instance Binary BranchCommit data Diff = Diff @@ -136,7 +136,7 @@ data Diff = Diff } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Diff where rnf = genericRnf +instance NFData Diff instance Binary Diff data NewGitReference = NewGitReference @@ -145,7 +145,7 @@ data NewGitReference = NewGitReference } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewGitReference where rnf = genericRnf +instance NFData NewGitReference instance Binary NewGitReference data GitReference = GitReference @@ -155,7 +155,7 @@ data GitReference = GitReference } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitReference where rnf = genericRnf +instance NFData GitReference instance Binary GitReference data GitObject = GitObject @@ -165,7 +165,7 @@ data GitObject = GitObject } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitObject where rnf = genericRnf +instance NFData GitObject instance Binary GitObject data GitUser = GitUser @@ -175,7 +175,7 @@ data GitUser = GitUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitUser where rnf = genericRnf +instance NFData GitUser instance Binary GitUser data File = File @@ -191,7 +191,7 @@ data File = File } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData File where rnf = genericRnf +instance NFData File instance Binary File -- JSON instances diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 1ea656f9..3267c2a3 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -21,7 +21,7 @@ data Invitation = Invitation } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Invitation where rnf = genericRnf +instance NFData Invitation instance Binary Invitation instance FromJSON Invitation where @@ -43,7 +43,7 @@ data InvitationRole deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData InvitationRole where rnf = genericRnf +instance NFData InvitationRole instance Binary InvitationRole instance FromJSON InvitationRole where @@ -67,7 +67,7 @@ data RepoInvitation = RepoInvitation } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoInvitation where rnf = genericRnf +instance NFData RepoInvitation instance Binary RepoInvitation instance FromJSON RepoInvitation where diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 191b342e..99928ece 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -35,7 +35,7 @@ data Issue = Issue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Issue where rnf = genericRnf +instance NFData Issue instance Binary Issue data NewIssue = NewIssue @@ -47,7 +47,7 @@ data NewIssue = NewIssue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewIssue where rnf = genericRnf +instance NFData NewIssue instance Binary NewIssue data EditIssue = EditIssue @@ -60,7 +60,7 @@ data EditIssue = EditIssue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditIssue where rnf = genericRnf +instance NFData EditIssue instance Binary EditIssue data IssueComment = IssueComment @@ -74,7 +74,7 @@ data IssueComment = IssueComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueComment where rnf = genericRnf +instance NFData IssueComment instance Binary IssueComment -- | See @@ -108,7 +108,7 @@ data EventType | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData EventType where rnf = genericRnf +instance NFData EventType instance Binary EventType -- | Issue event @@ -124,7 +124,7 @@ data IssueEvent = IssueEvent } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueEvent where rnf = genericRnf +instance NFData IssueEvent instance Binary IssueEvent instance FromJSON IssueEvent where diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 385678d1..aa907999 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -20,7 +20,7 @@ data Milestone = Milestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Milestone where rnf = genericRnf +instance NFData Milestone instance Binary Milestone instance FromJSON Milestone where @@ -44,7 +44,7 @@ data NewMilestone = NewMilestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewMilestone where rnf = genericRnf +instance NFData NewMilestone instance Binary NewMilestone @@ -67,7 +67,7 @@ data UpdateMilestone = UpdateMilestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData UpdateMilestone where rnf = genericRnf +instance NFData UpdateMilestone instance Binary UpdateMilestone diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index bf03c617..33899fbe 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -116,7 +116,7 @@ instance FromJSON IssueState where "closed" -> pure StateClosed _ -> fail $ "Unknown IssueState: " <> T.unpack t -instance NFData IssueState where rnf = genericRnf +instance NFData IssueState instance Binary IssueState -- | 'GitHub.Data.Issues.Issue' state reason @@ -143,7 +143,7 @@ instance FromJSON IssueStateReason where "reopened" -> pure StateReasonReopened _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t -instance NFData IssueStateReason where rnf = genericRnf +instance NFData IssueStateReason instance Binary IssueStateReason -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state @@ -178,7 +178,7 @@ instance FromJSON MergeableState where "draft" -> pure StateDraft _ -> fail $ "Unknown MergeableState: " <> T.unpack t -instance NFData MergeableState where rnf = genericRnf +instance NFData MergeableState instance Binary MergeableState data SortDirection @@ -187,7 +187,7 @@ data SortDirection deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortDirection where rnf = genericRnf +instance NFData SortDirection instance Binary SortDirection -- PR @@ -200,7 +200,7 @@ data SortPR deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortPR where rnf = genericRnf +instance NFData SortPR instance Binary SortPR -- Issue @@ -213,7 +213,7 @@ data IssueFilter deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData IssueFilter where rnf = genericRnf +instance NFData IssueFilter instance Binary IssueFilter data SortIssue @@ -223,7 +223,7 @@ data SortIssue deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortIssue where rnf = genericRnf +instance NFData SortIssue instance Binary SortIssue data FilterBy a @@ -245,7 +245,7 @@ data SortCache deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortCache where rnf = genericRnf +instance NFData SortCache instance Binary SortCache ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 79054b6a..660fd0a5 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -45,7 +45,7 @@ data SimplePullRequest = SimplePullRequest } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimplePullRequest where rnf = genericRnf +instance NFData SimplePullRequest instance Binary SimplePullRequest data PullRequest = PullRequest @@ -83,7 +83,7 @@ data PullRequest = PullRequest } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequest where rnf = genericRnf +instance NFData PullRequest instance Binary PullRequest data EditPullRequest = EditPullRequest @@ -96,7 +96,7 @@ data EditPullRequest = EditPullRequest } deriving (Show, Generic) -instance NFData EditPullRequest where rnf = genericRnf +instance NFData EditPullRequest instance Binary EditPullRequest data CreatePullRequest @@ -113,7 +113,7 @@ data CreatePullRequest } deriving (Show, Generic) -instance NFData CreatePullRequest where rnf = genericRnf +instance NFData CreatePullRequest instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks @@ -124,7 +124,7 @@ data PullRequestLinks = PullRequestLinks } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestLinks where rnf = genericRnf +instance NFData PullRequestLinks instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit @@ -136,7 +136,7 @@ data PullRequestCommit = PullRequestCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestCommit where rnf = genericRnf +instance NFData PullRequestCommit instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent @@ -148,7 +148,7 @@ data PullRequestEvent = PullRequestEvent } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestEvent where rnf = genericRnf +instance NFData PullRequestEvent instance Binary PullRequestEvent data PullRequestEventType @@ -165,7 +165,7 @@ data PullRequestEventType | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestEventType where rnf = genericRnf +instance NFData PullRequestEventType instance Binary PullRequestEventType data PullRequestReference = PullRequestReference @@ -175,7 +175,7 @@ data PullRequestReference = PullRequestReference } deriving (Eq, Ord, Show, Generic, Typeable, Data) -instance NFData PullRequestReference where rnf = genericRnf +instance NFData PullRequestReference instance Binary PullRequestReference diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 4e0b549c..d2b98d73 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -15,7 +15,7 @@ data Limits = Limits } deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) -instance NFData Limits where rnf = genericRnf +instance NFData Limits instance Binary Limits instance FromJSON Limits where @@ -31,7 +31,7 @@ data RateLimit = RateLimit } deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) -instance NFData RateLimit where rnf = genericRnf +instance NFData RateLimit instance Binary RateLimit instance FromJSON RateLimit where diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs index f5fc3ead..ade4ec7b 100644 --- a/src/GitHub/Data/Reactions.hs +++ b/src/GitHub/Data/Reactions.hs @@ -15,7 +15,7 @@ data Reaction = Reaction } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Reaction where rnf = genericRnf +instance NFData Reaction instance Binary Reaction data NewReaction = NewReaction @@ -23,7 +23,7 @@ data NewReaction = NewReaction } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewReaction where rnf = genericRnf +instance NFData NewReaction instance Binary NewReaction -- | @@ -39,7 +39,7 @@ data ReactionContent | Eyes deriving (Show, Data, Typeable, Eq, Ord, Enum, Bounded, Generic) -instance NFData ReactionContent where rnf = genericRnf +instance NFData ReactionContent instance Binary ReactionContent -- JSON instances diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs index 582b524c..0f9c40b7 100644 --- a/src/GitHub/Data/Releases.hs +++ b/src/GitHub/Data/Releases.hs @@ -47,7 +47,7 @@ instance FromJSON Release where <*> o .: "author" <*> o .: "assets" -instance NFData Release where rnf = genericRnf +instance NFData Release instance Binary Release data ReleaseAsset = ReleaseAsset @@ -81,5 +81,5 @@ instance FromJSON ReleaseAsset where <*> o .: "updated_at" <*> o .: "uploader" -instance NFData ReleaseAsset where rnf = genericRnf +instance NFData ReleaseAsset instance Binary ReleaseAsset diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 456775b6..8964c00b 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -55,7 +55,7 @@ data Repo = Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Repo where rnf = genericRnf +instance NFData Repo instance Binary Repo data CodeSearchRepo = CodeSearchRepo @@ -90,7 +90,7 @@ data CodeSearchRepo = CodeSearchRepo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CodeSearchRepo where rnf = genericRnf +instance NFData CodeSearchRepo instance Binary CodeSearchRepo -- | Repository permissions, as they relate to the authenticated user. @@ -103,7 +103,7 @@ data RepoPermissions = RepoPermissions } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoPermissions where rnf = genericRnf +instance NFData RepoPermissions instance Binary RepoPermissions data RepoRef = RepoRef @@ -112,7 +112,7 @@ data RepoRef = RepoRef } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoRef where rnf = genericRnf +instance NFData RepoRef instance Binary RepoRef data NewRepo = NewRepo @@ -131,7 +131,7 @@ data NewRepo = NewRepo , newRepoAllowRebaseMerge :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData NewRepo where rnf = genericRnf +instance NFData NewRepo instance Binary NewRepo newRepo :: Name Repo -> NewRepo @@ -153,7 +153,7 @@ data EditRepo = EditRepo } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData EditRepo where rnf = genericRnf +instance NFData EditRepo instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. @@ -175,7 +175,7 @@ newtype Language = Language Text 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 @@ -190,7 +190,7 @@ data Contributor | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Contributor where rnf = genericRnf +instance NFData Contributor instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser @@ -207,7 +207,7 @@ data CollaboratorPermission | CollaboratorPermissionNone deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData CollaboratorPermission where rnf = genericRnf +instance NFData CollaboratorPermission instance Binary CollaboratorPermission -- | A collaborator and its permission on a repository. @@ -216,7 +216,7 @@ data CollaboratorWithPermission = CollaboratorWithPermission SimpleUser CollaboratorPermission deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CollaboratorWithPermission where rnf = genericRnf +instance NFData CollaboratorWithPermission instance Binary CollaboratorWithPermission -- JSON instances diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c8138c1a..0ff3ae1b 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -100,7 +100,7 @@ instance Num FetchCount where instance Hashable FetchCount instance Binary FetchCount -instance NFData FetchCount where rnf = genericRnf +instance NFData FetchCount ------------------------------------------------------------------------------- -- PageParams @@ -115,7 +115,7 @@ data PageParams = PageParams { instance Hashable PageParams instance Binary PageParams -instance NFData PageParams where rnf = genericRnf +instance NFData PageParams ------------------------------------------------------------------------------- -- PageLinks @@ -131,7 +131,7 @@ data PageLinks = PageLinks { } deriving (Eq, Ord, Show, Generic, Typeable) -instance NFData PageLinks where rnf = genericRnf +instance NFData PageLinks ------------------------------------------------------------------------------- -- MediaType diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index b00edb74..c8761e0a 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -16,9 +16,7 @@ data ReviewState | ReviewStateChangesRequested deriving (Show, Enum, Bounded, Eq, Ord, Generic) -instance NFData ReviewState where - rnf = genericRnf - +instance NFData ReviewState instance Binary ReviewState instance FromJSON ReviewState where @@ -41,9 +39,7 @@ data Review = Review , reviewId :: !(Id Review) } deriving (Show, Generic) -instance NFData Review where - rnf = genericRnf - +instance NFData Review instance Binary Review instance FromJSON Review where @@ -74,9 +70,7 @@ data ReviewComment = ReviewComment , reviewCommentPullRequestUrl :: !URL } deriving (Show, Generic) -instance NFData ReviewComment where - rnf = genericRnf - +instance NFData ReviewComment instance Binary ReviewComment instance FromJSON ReviewComment where diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index b56067b0..fd333482 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -15,7 +15,7 @@ data SearchResult' entities = SearchResult type SearchResult entity = SearchResult' (V.Vector entity) -instance NFData entities => NFData (SearchResult' entities) where rnf = genericRnf +instance NFData entities => NFData (SearchResult' entities) instance Binary entities => Binary (SearchResult' entities) instance (Monoid entities, FromJSON entities) => FromJSON (SearchResult' entities) where @@ -40,7 +40,7 @@ data Code = Code } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Code where rnf = genericRnf +instance NFData Code instance Binary Code instance FromJSON Code where diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index 09853b26..5b488920 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -23,7 +23,7 @@ data StatusState | StatusFailure deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData StatusState where rnf = genericRnf +instance NFData StatusState instance Binary StatusState instance FromJSON StatusState where @@ -75,7 +75,7 @@ data NewStatus = NewStatus } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewStatus where rnf = genericRnf +instance NFData NewStatus instance Binary NewStatus instance ToJSON NewStatus where diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 622370ae..4f3da777 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -20,7 +20,7 @@ data Privacy | PrivacySecret deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData Privacy where rnf = genericRnf +instance NFData Privacy instance Binary Privacy data Permission @@ -29,7 +29,7 @@ data Permission | PermissionAdmin deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData Permission where rnf = genericRnf +instance NFData Permission instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission @@ -37,7 +37,7 @@ data AddTeamRepoPermission = AddTeamRepoPermission } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData AddTeamRepoPermission where rnf = genericRnf +instance NFData AddTeamRepoPermission instance Binary AddTeamRepoPermission data SimpleTeam = SimpleTeam @@ -53,7 +53,7 @@ data SimpleTeam = SimpleTeam } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleTeam where rnf = genericRnf +instance NFData SimpleTeam instance Binary SimpleTeam data Team = Team @@ -72,7 +72,7 @@ data Team = Team } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Team where rnf = genericRnf +instance NFData Team instance Binary Team data CreateTeam = CreateTeam @@ -84,7 +84,7 @@ data CreateTeam = CreateTeam } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateTeam where rnf = genericRnf +instance NFData CreateTeam instance Binary CreateTeam data EditTeam = EditTeam @@ -95,7 +95,7 @@ data EditTeam = EditTeam } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditTeam where rnf = genericRnf +instance NFData EditTeam instance Binary EditTeam data Role @@ -111,7 +111,7 @@ data ReqState | StateActive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ReqState where rnf = genericRnf +instance NFData ReqState instance Binary ReqState data TeamMembership = TeamMembership @@ -121,14 +121,14 @@ data TeamMembership = TeamMembership } deriving (Show, Data, Typeable, 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) -instance NFData CreateTeamMembership where rnf = genericRnf +instance NFData CreateTeamMembership instance Binary CreateTeamMembership -- JSON Instances diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index d98703ae..c3d9edcc 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -15,7 +15,7 @@ newtype URL = URL Text 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 143d8006..32e97287 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -22,7 +22,7 @@ data RepoWebhook = RepoWebhook } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhook where rnf = genericRnf +instance NFData RepoWebhook instance Binary RepoWebhook -- | See . @@ -87,7 +87,7 @@ data RepoWebhookEvent | WebhookWorkflowRun deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhookEvent where rnf = genericRnf +instance NFData RepoWebhookEvent instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse @@ -97,7 +97,7 @@ data RepoWebhookResponse = RepoWebhookResponse } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhookResponse where rnf = genericRnf +instance NFData RepoWebhookResponse instance Binary RepoWebhookResponse data PingEvent = PingEvent @@ -107,7 +107,7 @@ data PingEvent = PingEvent } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PingEvent where rnf = genericRnf +instance NFData PingEvent instance Binary PingEvent data NewRepoWebhook = NewRepoWebhook @@ -118,7 +118,7 @@ data NewRepoWebhook = NewRepoWebhook } deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData NewRepoWebhook where rnf = genericRnf +instance NFData NewRepoWebhook instance Binary NewRepoWebhook data EditRepoWebhook = EditRepoWebhook @@ -130,7 +130,7 @@ data EditRepoWebhook = EditRepoWebhook } deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData EditRepoWebhook where rnf = genericRnf +instance NFData EditRepoWebhook instance Binary EditRepoWebhook -- JSON instances diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index d6efaf39..03a38b13 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -7,7 +7,6 @@ module GitHub.Internal.Prelude ( module X ) where import Control.Applicative as X ((<|>)) import Control.DeepSeq as X (NFData (..)) -import Control.DeepSeq.Generics as X (genericRnf) import Data.Aeson as X (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) From 355eb4813f169eec5f12da279f6c208ff4785f7e Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:43:44 +0200 Subject: [PATCH 304/309] Bump dependency lower bounds to at least Stackage LTS 10.0 (GHC 8.2.2) --- github.cabal | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/github.cabal b/github.cabal index b9843588..ba4bae57 100644 --- a/github.cabal +++ b/github.cabal @@ -184,17 +184,18 @@ library 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.7.1.0 && <0.11 - , bytestring >=0.10.4.0 && <0.13 - , containers >=0.5.5.1 && <1 - , deepseq >=1.3.0.2 && <1.6 + , 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.1.3.1 && <2.2 || >=2.2.1 && <2.4 - , text >=1.2.0.6 && <2.2 + , mtl >=2.2.1 && <2.4 + , text >=1.2.2.2 && <2.2 , time >=1.8.0.2 && <2 - , transformers >=0.3.0.0 && <0.7 + , transformers >=0.5.2.0 && <0.7 -- other packages build-depends: From 81009cb0f4dd5dd442ef46379d84cb7c6828a9f2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:47:05 +0200 Subject: [PATCH 305/309] Remove unused dependency transformers-compat --- github.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/github.cabal b/github.cabal index ba4bae57..54f0d2a1 100644 --- a/github.cabal +++ b/github.cabal @@ -211,7 +211,6 @@ library , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , tagged >=0.8.5 && <0.9 - , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.14 From 50e43d5e6790ee5f7630821709b94db47b43a0c4 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:51:35 +0200 Subject: [PATCH 306/309] Remove obsolete `deriving Typeable` --- src/GitHub/Auth.hs | 2 +- src/GitHub/Data/Actions/Artifacts.hs | 4 +-- src/GitHub/Data/Actions/Cache.hs | 6 ++-- src/GitHub/Data/Actions/Common.hs | 2 +- src/GitHub/Data/Actions/Secrets.hs | 16 +++++----- src/GitHub/Data/Actions/WorkflowJobs.hs | 6 ++-- src/GitHub/Data/Actions/WorkflowRuns.hs | 6 ++-- src/GitHub/Data/Actions/Workflows.hs | 2 +- src/GitHub/Data/Activities.hs | 8 ++--- src/GitHub/Data/Comments.hs | 10 +++--- src/GitHub/Data/Content.hs | 22 ++++++------- src/GitHub/Data/Definitions.hs | 34 ++++++++++----------- src/GitHub/Data/DeployKeys.hs | 4 +-- src/GitHub/Data/Deployments.hs | 12 ++++---- src/GitHub/Data/Email.hs | 4 +-- src/GitHub/Data/Enterprise/Organizations.hs | 6 ++-- src/GitHub/Data/Events.hs | 2 +- src/GitHub/Data/Gists.hs | 10 +++--- src/GitHub/Data/GitData.hs | 32 +++++++++---------- src/GitHub/Data/Id.hs | 2 +- src/GitHub/Data/Invitation.hs | 6 ++-- src/GitHub/Data/Issues.hs | 12 ++++---- src/GitHub/Data/Milestone.hs | 6 ++-- src/GitHub/Data/Name.hs | 2 +- src/GitHub/Data/Options.hs | 30 +++++++++--------- src/GitHub/Data/PublicSSHKeys.hs | 6 ++-- src/GitHub/Data/PullRequests.hs | 16 +++++----- src/GitHub/Data/RateLimit.hs | 4 +-- src/GitHub/Data/Reactions.hs | 6 ++-- src/GitHub/Data/Releases.hs | 4 +-- src/GitHub/Data/Repos.hs | 24 +++++++-------- src/GitHub/Data/Request.hs | 13 ++++---- src/GitHub/Data/Search.hs | 4 +-- src/GitHub/Data/Statuses.hs | 12 +++----- src/GitHub/Data/Teams.hs | 27 ++++++++-------- src/GitHub/Data/URL.hs | 2 +- src/GitHub/Data/Webhooks.hs | 12 ++++---- src/GitHub/Internal/Prelude.hs | 2 +- 38 files changed, 186 insertions(+), 192 deletions(-) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 1800808f..cd53cd2e 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -23,7 +23,7 @@ data Auth | OAuth Token -- ^ OAuth token | JWT JWTToken -- ^ JWT Token | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Auth instance Binary Auth diff --git a/src/GitHub/Data/Actions/Artifacts.hs b/src/GitHub/Data/Actions/Artifacts.hs index 7b572d2b..9d8ca28e 100644 --- a/src/GitHub/Data/Actions/Artifacts.hs +++ b/src/GitHub/Data/Actions/Artifacts.hs @@ -27,7 +27,7 @@ data ArtifactWorkflowRun = ArtifactWorkflowRun , artifactWorkflowRunHeadBranch :: !Text , artifactWorkflowRunHeadSha :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data Artifact = Artifact { artifactArchiveDownloadUrl :: !URL @@ -42,7 +42,7 @@ data Artifact = Artifact , artifactUrl :: !URL , artifactWorkflowRun :: !ArtifactWorkflowRun } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/Cache.hs b/src/GitHub/Data/Actions/Cache.hs index a4f65a60..363e0ce3 100644 --- a/src/GitHub/Data/Actions/Cache.hs +++ b/src/GitHub/Data/Actions/Cache.hs @@ -27,20 +27,20 @@ data Cache = Cache , cacheCreatedAt :: !UTCTime , cacheSizeInBytes :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data RepositoryCacheUsage = RepositoryCacheUsage { repositoryCacheUsageFullName :: !Text , repositoryCacheUsageActiveCachesSizeInBytes :: !Int , repositoryCacheUsageActiveCachesCount :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data OrganizationCacheUsage = OrganizationCacheUsage { organizationCacheUsageTotalActiveCachesSizeInBytes :: !Int , organizationCacheUsageTotalActiveCachesCount :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/Common.hs b/src/GitHub/Data/Actions/Common.hs index ed02b6f0..76a6130a 100644 --- a/src/GitHub/Data/Actions/Common.hs +++ b/src/GitHub/Data/Actions/Common.hs @@ -20,7 +20,7 @@ data WithTotalCount a = WithTotalCount , withTotalCountTotalCount :: !Int -- ^ The total size of the answer. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -- | Joining two pages of a paginated response. -- The 'withTotalCountTotalCount' is assumed to be the same in both pages, diff --git a/src/GitHub/Data/Actions/Secrets.hs b/src/GitHub/Data/Actions/Secrets.hs index c734ad89..1e2ce31b 100644 --- a/src/GitHub/Data/Actions/Secrets.hs +++ b/src/GitHub/Data/Actions/Secrets.hs @@ -33,13 +33,13 @@ data OrganizationSecret = OrganizationSecret , organizationSecretUpdatedAt :: !UTCTime , organizationSecretVisibility :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data PublicKey = PublicKey { publicKeyId :: !Text , publicKeyKey :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SetSecret = SetSecret { setSecretPublicKeyId :: !Text @@ -47,35 +47,35 @@ data SetSecret = SetSecret , setSecretVisibility :: !Text , setSecretSelectedRepositoryIds :: !(Maybe [Id Repo]) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SetRepoSecret = SetRepoSecret { setRepoSecretPublicKeyId :: !Text , setRepoSecretEncryptedValue :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SelectedRepo = SelectedRepo { selectedRepoRepoId :: !(Id Repo) , selectedRepoRepoName :: !(Name Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SetSelectedRepositories = SetSelectedRepositories { setSelectedRepositoriesRepositoryIds :: ![Id Repo] } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data RepoSecret = RepoSecret { repoSecretName :: !(Name RepoSecret) , repoSecretCreatedAt :: !UTCTime , repoSecretUpdatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -- TODO move somewhere else? data Environment = Environment - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/WorkflowJobs.hs b/src/GitHub/Data/Actions/WorkflowJobs.hs index 05f28861..47f11f20 100644 --- a/src/GitHub/Data/Actions/WorkflowJobs.hs +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -10,7 +10,7 @@ module GitHub.Data.Actions.WorkflowJobs ( import Prelude () import GitHub.Internal.Prelude (Applicative ((<*>)), Data, Eq, FromJSON (parseJSON), Generic, Integer, - Ord, Show, Text, Typeable, UTCTime, Vector, withObject, ($), (.:), + Ord, Show, Text, UTCTime, Vector, withObject, ($), (.:), (<$>)) import GitHub.Data.Id (Id) @@ -32,7 +32,7 @@ data JobStep = JobStep , jobStepStartedAt :: !UTCTime , jobStepCompletedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data Job = Job { jobId :: !(Id Job) @@ -56,7 +56,7 @@ data Job = Job , jobRunnerGroupId :: !Integer , jobRunnerGroupName :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/WorkflowRuns.hs b/src/GitHub/Data/Actions/WorkflowRuns.hs index 3dae581b..07657e84 100644 --- a/src/GitHub/Data/Actions/WorkflowRuns.hs +++ b/src/GitHub/Data/Actions/WorkflowRuns.hs @@ -41,10 +41,10 @@ data WorkflowRun = WorkflowRun , workflowRunAttempt :: !Integer , workflowRunStartedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data RunAttempt = RunAttempt - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data ReviewHistory = ReviewHistory { reviewHistoryState :: !Text @@ -52,7 +52,7 @@ data ReviewHistory = ReviewHistory , reviewHistoryUser :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/Workflows.hs b/src/GitHub/Data/Actions/Workflows.hs index ae36ddbf..a75fa0ff 100644 --- a/src/GitHub/Data/Actions/Workflows.hs +++ b/src/GitHub/Data/Actions/Workflows.hs @@ -25,7 +25,7 @@ data Workflow = Workflow , workflowHtmlUrl :: !URL , workflowBadgeUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent { createWorkflowDispatchEventRef :: !Text diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 70e356cf..b480ef21 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -13,7 +13,7 @@ data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime , repoStarredRepo :: !Repo } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoStarred instance Binary RepoStarred @@ -33,7 +33,7 @@ data Subject = Subject -- TODO: Make an ADT for this. , subjectType :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Subject instance Binary Subject @@ -61,7 +61,7 @@ data NotificationReason | StateChangeReason | SubscribedReason | TeamMentionReason - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData NotificationReason instance Binary NotificationReason @@ -97,7 +97,7 @@ data Notification = Notification , notificationLastReadAt :: !(Maybe UTCTime) , notificationUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Notification instance Binary Notification diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 0084cd9b..c5987c77 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -19,7 +19,7 @@ data Comment = Comment , commentUser :: !SimpleUser , commentId :: !(Id Comment) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Comment instance Binary Comment @@ -41,7 +41,7 @@ instance FromJSON Comment where data NewComment = NewComment { newCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewComment instance Binary NewComment @@ -52,7 +52,7 @@ instance ToJSON NewComment where data EditComment = EditComment { editCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData EditComment instance Binary EditComment @@ -66,7 +66,7 @@ data NewPullComment = NewPullComment , newPullCommentPosition :: !Int , newPullCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewPullComment instance Binary NewPullComment @@ -82,7 +82,7 @@ instance ToJSON NewPullComment where data PullCommentReply = PullCommentReply { pullCommentReplyBody :: Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullCommentReply diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 2ac55039..5e0c4b92 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -18,7 +18,7 @@ import Data.Aeson (Key) data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Content instance Binary Content @@ -28,7 +28,7 @@ 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 instance Binary ContentFileData @@ -37,13 +37,13 @@ instance Binary ContentFileData data ContentItem = ContentItem { contentItemType :: !ContentItemType ,contentItemInfo :: !ContentInfo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) 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 instance Binary ContentItemType @@ -56,7 +56,7 @@ data ContentInfo = ContentInfo { ,contentUrl :: !URL ,contentGitUrl :: !URL ,contentHtmlUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentInfo instance Binary ContentInfo @@ -64,7 +64,7 @@ instance Binary ContentInfo data ContentResultInfo = ContentResultInfo { contentResultInfo :: !ContentInfo , contentResultSize :: !Int - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentResultInfo instance Binary ContentResultInfo @@ -72,7 +72,7 @@ instance Binary ContentResultInfo data ContentResult = ContentResult { contentResultContent :: !ContentResultInfo , contentResultCommit :: !GitCommit - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentResult instance Binary ContentResult @@ -81,7 +81,7 @@ data Author = Author { authorName :: !Text , authorEmail :: !Text } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData Author instance Binary Author @@ -94,7 +94,7 @@ data CreateFile = CreateFile , createFileAuthor :: !(Maybe Author) , createFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData CreateFile instance Binary CreateFile @@ -108,7 +108,7 @@ data UpdateFile = UpdateFile , updateFileAuthor :: !(Maybe Author) , updateFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData UpdateFile instance Binary UpdateFile @@ -121,7 +121,7 @@ data DeleteFile = DeleteFile , deleteFileAuthor :: !(Maybe Author) , deleteFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData DeleteFile instance Binary DeleteFile diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 060c4bec..12f392df 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -22,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 | OwnerBot - deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data) instance NFData OwnerType instance Binary OwnerType @@ -39,7 +39,7 @@ data SimpleUser = SimpleUser , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleUser instance Binary SimpleUser @@ -50,7 +50,7 @@ data SimpleOrganization = SimpleOrganization , simpleOrganizationUrl :: !URL , simpleOrganizationAvatarUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleOrganization instance Binary SimpleOrganization @@ -63,7 +63,7 @@ data SimpleOwner = SimpleOwner , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleOwner instance Binary SimpleOwner @@ -88,7 +88,7 @@ data User = User , userUrl :: !URL , userHtmlUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData User instance Binary User @@ -111,14 +111,14 @@ data Organization = Organization , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Organization instance Binary Organization -- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Owner instance Binary Owner @@ -218,14 +218,14 @@ instance FromJSON Owner where 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)] @@ -240,7 +240,7 @@ data MembershipRole | MembershipRoleAdmin | MembershipRoleBillingManager deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData MembershipRole instance Binary MembershipRole @@ -255,7 +255,7 @@ instance FromJSON MembershipRole where data MembershipState = MembershipPending | MembershipActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData MembershipState instance Binary MembershipState @@ -275,7 +275,7 @@ data Membership = Membership , membershipOrganization :: !SimpleOrganization , membershipUser :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Membership instance Binary Membership @@ -295,7 +295,7 @@ instance FromJSON Membership where ------------------------------------------------------------------------------- newtype IssueNumber = IssueNumber Int - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) unIssueNumber :: IssueNumber -> Int unIssueNumber (IssueNumber i) = i @@ -322,7 +322,7 @@ data IssueLabel = IssueLabel , labelName :: !(Name IssueLabel) , labelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData IssueLabel instance Binary IssueLabel @@ -344,7 +344,7 @@ data NewIssueLabel = NewIssueLabel , newLabelName :: !(Name NewIssueLabel) , newLabelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewIssueLabel instance Binary NewIssueLabel @@ -371,7 +371,7 @@ data UpdateIssueLabel = UpdateIssueLabel , updateLabelName :: !(Name UpdateIssueLabel) , updateLabelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData UpdateIssueLabel instance Binary UpdateIssueLabel diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index 7dd1bb1d..af43c6cf 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -19,7 +19,7 @@ data RepoDeployKey = RepoDeployKey , repoDeployKeyCreatedAt :: !UTCTime , repoDeployKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON RepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey @@ -36,7 +36,7 @@ data NewRepoDeployKey = NewRepoDeployKey , newRepoDeployKeyTitle :: !Text , newRepoDeployKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where toJSON (NewRepoDeployKey key title readOnly) = object diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index b8ba2df0..043e74be 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -34,7 +34,7 @@ data DeploymentQueryOption | DeploymentQueryRef !Text | DeploymentQueryTask !Text | DeploymentQueryEnvironment !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData DeploymentQueryOption instance Binary DeploymentQueryOption @@ -61,7 +61,7 @@ data Deployment a = Deployment , deploymentUpdatedAt :: !UTCTime , deploymentStatusesUrl :: !URL , deploymentRepositoryUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData a => NFData (Deployment a) instance Binary a => Binary (Deployment a) @@ -104,7 +104,7 @@ data CreateDeployment a = CreateDeployment -- qa). Default: production , createDeploymentDescription :: !(Maybe Text) -- ^ Short description of the deployment. Default: "" - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData a => NFData (CreateDeployment a) instance Binary a => Binary (CreateDeployment a) @@ -132,7 +132,7 @@ data DeploymentStatus = DeploymentStatus , deploymentStatusUpdatedAt :: !UTCTime , deploymentStatusDeploymentUrl :: !URL , deploymentStatusRepositoryUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData DeploymentStatus instance Binary DeploymentStatus @@ -157,7 +157,7 @@ data DeploymentStatusState | DeploymentStatusPending | DeploymentStatusSuccess | DeploymentStatusInactive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData DeploymentStatusState instance Binary DeploymentStatusState @@ -190,7 +190,7 @@ data CreateDeploymentStatus = CreateDeploymentStatus , createDeploymentStatusDescription :: !(Maybe Text) -- ^ A short description of the status. Maximum length of 140 characters. -- Default: "" - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateDeploymentStatus instance Binary CreateDeploymentStatus diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index 6e151760..76efafa0 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -8,7 +8,7 @@ import qualified Data.Text as T data EmailVisibility = EmailVisibilityPrivate | EmailVisibilityPublic - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData EmailVisibility instance Binary EmailVisibility @@ -24,7 +24,7 @@ data Email = Email , emailVerified :: !Bool , emailPrimary :: !Bool , emailVisibility :: !(Maybe EmailVisibility) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData Email instance Binary Email diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs index 29f179af..02c99453 100644 --- a/src/GitHub/Data/Enterprise/Organizations.hs +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -11,7 +11,7 @@ data CreateOrganization = CreateOrganization , createOrganizationAdmin :: !(Name User) , createOrganizationProfileName :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateOrganization instance Binary CreateOrganization @@ -19,7 +19,7 @@ instance Binary CreateOrganization data RenameOrganization = RenameOrganization { renameOrganizationLogin :: !(Name Organization) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RenameOrganization instance Binary RenameOrganization @@ -28,7 +28,7 @@ data RenameOrganizationResponse = RenameOrganizationResponse { renameOrganizationResponseMessage :: !Text , renameOrganizationResponseUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RenameOrganizationResponse instance Binary RenameOrganizationResponse diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index 16b85eca..4025aae7 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -16,7 +16,7 @@ data Event = Event , eventCreatedAt :: !UTCTime , eventPublic :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Event instance Binary Event diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 7e46c686..983b7a1d 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -21,7 +21,7 @@ data Gist = Gist , gistId :: !(Name Gist) , gistFiles :: !(HashMap Text GistFile) , gistGitPullUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) instance NFData Gist instance Binary Gist @@ -49,7 +49,7 @@ data GistFile = GistFile , gistFileFilename :: !Text , gistFileContent :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Generic) + deriving (Show, Data, Eq, Generic) instance NFData GistFile instance Binary GistFile @@ -71,7 +71,7 @@ data GistComment = GistComment , gistCommentUpdatedAt :: !UTCTime , gistCommentId :: !(Id GistComment) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GistComment instance Binary GistComment @@ -89,7 +89,7 @@ data NewGist = NewGist { newGistDescription :: !(Maybe Text) , newGistFiles :: !(HashMap Text NewGistFile) , newGistPublic :: !(Maybe Bool) - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) instance NFData NewGist instance Binary NewGist @@ -109,7 +109,7 @@ instance ToJSON NewGist where data NewGistFile = NewGistFile { newGistFileContent :: !Text - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) instance NFData NewGistFile instance Binary NewGistFile diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index d4fd8798..41158632 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -15,14 +15,14 @@ data CommitQueryOption | CommitQueryAuthor !Text | CommitQuerySince !UTCTime | CommitQueryUntil !UTCTime - deriving (Show, Eq, Ord, Generic, Typeable, Data) + deriving (Show, Eq, Ord, Generic, Data) data Stats = Stats { statsAdditions :: !Int , statsTotal :: !Int , statsDeletions :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Stats instance Binary Stats @@ -37,7 +37,7 @@ data Commit = Commit , commitFiles :: !(Vector File) , commitStats :: !(Maybe Stats) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Commit instance Binary Commit @@ -47,7 +47,7 @@ data Tree = Tree , treeUrl :: !URL , treeGitTrees :: !(Vector GitTree) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Tree instance Binary Tree @@ -61,7 +61,7 @@ data GitTree = GitTree , gitTreePath :: !Text , gitTreeMode :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitTree instance Binary GitTree @@ -75,7 +75,7 @@ data GitCommit = GitCommit , gitCommitSha :: !(Maybe (Name GitCommit)) , gitCommitParents :: !(Vector Tree) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitCommit instance Binary GitCommit @@ -87,7 +87,7 @@ data Blob = Blob , blobSha :: !(Name Blob) , blobSize :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Blob instance Binary Blob @@ -98,7 +98,7 @@ data Tag = Tag , tagTarballUrl :: !URL , tagCommit :: !BranchCommit } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Tag instance Binary Tag @@ -107,7 +107,7 @@ data Branch = Branch { branchName :: !Text , branchCommit :: !BranchCommit } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Branch @@ -115,7 +115,7 @@ data BranchCommit = BranchCommit { branchCommitSha :: !Text , branchCommitUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData BranchCommit instance Binary BranchCommit @@ -134,7 +134,7 @@ data Diff = Diff , diffDiffUrl :: !URL , diffPermalinkUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Diff instance Binary Diff @@ -143,7 +143,7 @@ data NewGitReference = NewGitReference { newGitReferenceRef :: !Text , newGitReferenceSha :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewGitReference instance Binary NewGitReference @@ -153,7 +153,7 @@ data GitReference = GitReference , gitReferenceUrl :: !URL , gitReferenceRef :: !(Name GitReference) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitReference instance Binary GitReference @@ -163,7 +163,7 @@ data GitObject = GitObject , gitObjectSha :: !Text , gitObjectUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitObject instance Binary GitObject @@ -173,7 +173,7 @@ data GitUser = GitUser , gitUserEmail :: !Text , gitUserDate :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitUser instance Binary GitUser @@ -189,7 +189,7 @@ data File = File , fileFilename :: !Text , fileDeletions :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData File instance Binary File diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index ddbc9e25..6c18c2e2 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -9,7 +9,7 @@ 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 index 3267c2a3..5818a296 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -19,7 +19,7 @@ data Invitation = Invitation , invitationCreatedAt :: !UTCTime , inviter :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Invitation instance Binary Invitation @@ -41,7 +41,7 @@ data InvitationRole | InvitationRoleHiringManager | InvitationRoleReinstate deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData InvitationRole instance Binary InvitationRole @@ -65,7 +65,7 @@ data RepoInvitation = RepoInvitation , repoInvitationPermission :: !Text , repoInvitationHtmlUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoInvitation instance Binary RepoInvitation diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 99928ece..2f815c0d 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -33,7 +33,7 @@ data Issue = Issue , issueMilestone :: !(Maybe Milestone) , issueStateReason :: !(Maybe IssueStateReason) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Issue instance Binary Issue @@ -45,7 +45,7 @@ data NewIssue = NewIssue , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewIssue instance Binary NewIssue @@ -58,7 +58,7 @@ data EditIssue = EditIssue , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData EditIssue instance Binary EditIssue @@ -72,7 +72,7 @@ data IssueComment = IssueComment , issueCommentBody :: !Text , issueCommentId :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData IssueComment instance Binary IssueComment @@ -106,7 +106,7 @@ data EventType | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. | RemovedFromProject -- ^ The issue was removed from a project board. | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData EventType instance Binary EventType @@ -122,7 +122,7 @@ data IssueEvent = IssueEvent , issueEventIssue :: !(Maybe Issue) , issueEventLabel :: !(Maybe IssueLabel) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData IssueEvent instance Binary IssueEvent diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index aa907999..789b2324 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -18,7 +18,7 @@ data Milestone = Milestone , milestoneCreatedAt :: !UTCTime , milestoneState :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Milestone instance Binary Milestone @@ -42,7 +42,7 @@ data NewMilestone = NewMilestone , newMilestoneDescription :: !(Maybe Text) , newMilestoneDueOn :: !(Maybe UTCTime) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewMilestone instance Binary NewMilestone @@ -65,7 +65,7 @@ data UpdateMilestone = UpdateMilestone , updateMilestoneDescription :: !(Maybe Text) , updateMilestoneDueOn :: !(Maybe UTCTime) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData UpdateMilestone instance Binary UpdateMilestone diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 99554287..a9ecf8e5 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -11,7 +11,7 @@ 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 diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 33899fbe..da137f0f 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -104,7 +104,7 @@ data IssueState = StateOpen | StateClosed deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON IssueState where toJSON StateOpen = String "open" @@ -126,7 +126,7 @@ data IssueStateReason | StateReasonNotPlanned | StateReasonReopened deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON IssueStateReason where toJSON = String . \case @@ -156,7 +156,7 @@ data MergeableState | StateBehind | StateDraft deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON MergeableState where toJSON StateUnknown = String "unknown" @@ -185,7 +185,7 @@ data SortDirection = SortAscending | SortDescending deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortDirection instance Binary SortDirection @@ -198,7 +198,7 @@ data SortPR | SortPRPopularity | SortPRLongRunning deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortPR instance Binary SortPR @@ -211,7 +211,7 @@ data IssueFilter | IssueFilterSubscribed | IssueFilterAll deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData IssueFilter instance Binary IssueFilter @@ -221,7 +221,7 @@ data SortIssue | SortIssueUpdated | SortIssueComments deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortIssue instance Binary SortIssue @@ -234,7 +234,7 @@ data FilterBy a -- ^ e.g. for milestones "any" means "any milestone". -- I.e. won't show issues without mileston specified deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) -- Actions cache @@ -243,7 +243,7 @@ data SortCache | SortCacheLastAccessedAt | SortCacheSizeInBytes deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortCache instance Binary SortCache @@ -334,7 +334,7 @@ data PullRequestOptions = PullRequestOptions , pullRequestOptionsDirection :: !SortDirection } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultPullRequestOptions :: PullRequestOptions defaultPullRequestOptions = PullRequestOptions @@ -429,7 +429,7 @@ data IssueOptions = IssueOptions , issueOptionsSince :: !(Maybe UTCTime) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultIssueOptions :: IssueOptions defaultIssueOptions = IssueOptions @@ -575,7 +575,7 @@ data IssueRepoOptions = IssueRepoOptions , issueRepoOptionsSince :: !(Maybe UTCTime) -- ^ 'HasSince' } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions @@ -714,7 +714,7 @@ data ArtifactOptions = ArtifactOptions { artifactOptionsName :: !(Maybe Text) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultArtifactOptions :: ArtifactOptions defaultArtifactOptions = ArtifactOptions @@ -763,7 +763,7 @@ data CacheOptions = CacheOptions , cacheOptionsDirection :: !(Maybe SortDirection) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultCacheOptions :: CacheOptions defaultCacheOptions = CacheOptions @@ -863,7 +863,7 @@ data WorkflowRunOptions = WorkflowRunOptions , workflowRunOptionsHeadSha :: !(Maybe Text) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultWorkflowRunOptions :: WorkflowRunOptions defaultWorkflowRunOptions = WorkflowRunOptions diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs index 125cd4aa..a7bf18f9 100644 --- a/src/GitHub/Data/PublicSSHKeys.hs +++ b/src/GitHub/Data/PublicSSHKeys.hs @@ -14,7 +14,7 @@ data PublicSSHKeyBasic = PublicSSHKeyBasic { basicPublicSSHKeyId :: !(Id PublicSSHKey) , basicPublicSSHKeyKey :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON PublicSSHKeyBasic where parseJSON = withObject "PublicSSHKeyBasic" $ \o -> PublicSSHKeyBasic @@ -30,7 +30,7 @@ data PublicSSHKey = PublicSSHKey , publicSSHKeyCreatedAt :: !(Maybe UTCTime) , publicSSHKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON PublicSSHKey where parseJSON = withObject "PublicSSHKey" $ \o -> PublicSSHKey @@ -46,7 +46,7 @@ data NewPublicSSHKey = NewPublicSSHKey { newPublicSSHKeyKey :: !Text , newPublicSSHKeyTitle :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance ToJSON NewPublicSSHKey where toJSON (NewPublicSSHKey key title) = object diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 660fd0a5..74370960 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -43,7 +43,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimplePullRequest instance Binary SimplePullRequest @@ -81,7 +81,7 @@ data PullRequest = PullRequest , pullRequestMergeable :: !(Maybe Bool) , pullRequestMergeableState :: !MergeableState } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequest instance Binary PullRequest @@ -122,7 +122,7 @@ data PullRequestLinks = PullRequestLinks , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestLinks instance Binary PullRequestLinks @@ -134,7 +134,7 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !(Maybe Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestCommit instance Binary PullRequestCommit @@ -146,7 +146,7 @@ data PullRequestEvent = PullRequestEvent , pullRequestRepository :: !Repo , pullRequestSender :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestEvent instance Binary PullRequestEvent @@ -163,7 +163,7 @@ data PullRequestEventType | PullRequestReviewRequested | PullRequestReviewRequestRemoved | PullRequestEdited - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestEventType instance Binary PullRequestEventType @@ -173,7 +173,7 @@ data PullRequestReference = PullRequestReference , pullRequestReferencePatchUrl :: !(Maybe URL) , pullRequestReferenceDiffUrl :: !(Maybe URL) } - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) instance NFData PullRequestReference instance Binary PullRequestReference @@ -316,4 +316,4 @@ data MergeResult = MergeSuccessful | MergeCannotPerform | MergeConflict - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index d2b98d73..743a096e 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -13,7 +13,7 @@ data Limits = Limits , limitsRemaining :: !Int , limitsReset :: !SystemTime } - deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic) instance NFData Limits instance Binary Limits @@ -29,7 +29,7 @@ data RateLimit = RateLimit , rateLimitSearch :: Limits , rateLimitGraphQL :: Limits } - deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic) instance NFData RateLimit instance Binary RateLimit diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs index ade4ec7b..574fda00 100644 --- a/src/GitHub/Data/Reactions.hs +++ b/src/GitHub/Data/Reactions.hs @@ -13,7 +13,7 @@ data Reaction = Reaction , reactionContent :: !ReactionContent , reactionCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Reaction instance Binary Reaction @@ -21,7 +21,7 @@ instance Binary Reaction data NewReaction = NewReaction { newReactionContent :: !ReactionContent } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewReaction instance Binary NewReaction @@ -37,7 +37,7 @@ data ReactionContent | Hooray | Rocket | Eyes - deriving (Show, Data, Typeable, Eq, Ord, Enum, Bounded, Generic) + deriving (Show, Data, Eq, Ord, Enum, Bounded, Generic) instance NFData ReactionContent instance Binary ReactionContent diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs index 0f9c40b7..7f87b825 100644 --- a/src/GitHub/Data/Releases.hs +++ b/src/GitHub/Data/Releases.hs @@ -25,7 +25,7 @@ data Release = Release , releaseAuthor :: !SimpleUser , releaseAssets :: !(Vector ReleaseAsset) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON Release where parseJSON = withObject "Event" $ \o -> Release @@ -64,7 +64,7 @@ data ReleaseAsset = ReleaseAsset , releaseAssetUpdatedAt :: !UTCTime , releaseAssetUploader :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON ReleaseAsset where parseJSON = withObject "Event" $ \o -> ReleaseAsset diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 8964c00b..6dce3919 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -53,7 +53,7 @@ data Repo = Repo , repoUpdatedAt :: !(Maybe UTCTime) , repoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Repo instance Binary Repo @@ -88,7 +88,7 @@ data CodeSearchRepo = CodeSearchRepo , codeSearchRepoUpdatedAt :: !(Maybe UTCTime) , codeSearchRepoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CodeSearchRepo instance Binary CodeSearchRepo @@ -101,7 +101,7 @@ data RepoPermissions = RepoPermissions , repoPermissionPush :: !Bool , repoPermissionPull :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoPermissions instance Binary RepoPermissions @@ -110,7 +110,7 @@ data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoRef instance Binary RepoRef @@ -129,7 +129,7 @@ data NewRepo = NewRepo , newRepoAllowSquashMerge :: !(Maybe Bool) , newRepoAllowMergeCommit :: !(Maybe Bool) , newRepoAllowRebaseMerge :: !(Maybe Bool) - } deriving (Eq, Ord, Show, Data, Typeable, Generic) + } deriving (Eq, Ord, Show, Data, Generic) instance NFData NewRepo instance Binary NewRepo @@ -151,7 +151,7 @@ data EditRepo = EditRepo , editAllowRebaseMerge :: !(Maybe Bool) , editArchived :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData EditRepo instance Binary EditRepo @@ -163,14 +163,14 @@ 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 @@ -188,7 +188,7 @@ data Contributor = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Contributor instance Binary Contributor @@ -205,7 +205,7 @@ data CollaboratorPermission | CollaboratorPermissionWrite | CollaboratorPermissionRead | CollaboratorPermissionNone - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData CollaboratorPermission instance Binary CollaboratorPermission @@ -214,7 +214,7 @@ instance Binary CollaboratorPermission -- See data CollaboratorWithPermission = CollaboratorWithPermission SimpleUser CollaboratorPermission - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CollaboratorWithPermission instance Binary CollaboratorWithPermission @@ -381,7 +381,7 @@ instance FromJSONKey Language where data ArchiveFormat = ArchiveFormatTarball -- ^ ".tar.gz" format | ArchiveFormatZipball -- ^ ".zip" format - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) instance IsPathPart ArchiveFormat where toPathPart af = case af of diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 0ff3ae1b..07ac89dd 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,7 +61,7 @@ data CommandMethod | Patch | Put | Delete - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) instance Hashable CommandMethod @@ -81,7 +81,7 @@ data FetchCount = FetchAtLeast !Word | FetchAll | FetchPage PageParams - deriving (Eq, Ord, Read, Show, Generic, Typeable) + deriving (Eq, Ord, Read, Show, Generic) -- | This instance is there mostly for 'fromInteger'. @@ -111,7 +111,7 @@ data PageParams = PageParams { pageParamsPerPage :: Maybe Int , pageParamsPage :: Maybe Int } - deriving (Eq, Ord, Read, Show, Generic, Typeable) + deriving (Eq, Ord, Read, Show, Generic) instance Hashable PageParams instance Binary PageParams @@ -129,7 +129,7 @@ data PageLinks = PageLinks { , pageLinksLast :: Maybe URI , pageLinksFirst :: Maybe URI } - deriving (Eq, Ord, Show, Generic, Typeable) + deriving (Eq, Ord, Show, Generic) instance NFData PageLinks @@ -148,7 +148,7 @@ data MediaType a | MtStatus -- ^ Parse status | MtUnit -- ^ Always succeeds | MtPreview a -- ^ Some other (preview) type; this is an extension point. - deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Data, Generic) ------------------------------------------------------------------------------ -- RW @@ -160,7 +160,7 @@ data RW = RO -- ^ /Read-only/, doesn't necessarily requires authentication | RA -- ^ /Read authenticated/ | RW -- ^ /Read-write/, requires authentication - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) {- data SRO (rw :: RW) where @@ -194,7 +194,6 @@ data GenRequest (mt :: MediaType *) (rw :: RW) a where -> Paths -- ^ path -> LBS.ByteString -- ^ body -> GenRequest mt 'RW a - deriving (Typeable) -- | Most requests ask for @JSON@. type Request = GenRequest 'MtJSON diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index fd333482..a84710d2 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -11,7 +11,7 @@ data SearchResult' entities = SearchResult { searchResultTotalCount :: !Int , searchResultResults :: !entities } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) type SearchResult entity = SearchResult' (V.Vector entity) @@ -38,7 +38,7 @@ data Code = Code , codeHtmlUrl :: !URL , codeRepo :: !CodeSearchRepo } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Code instance Binary Code diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index 5b488920..a2e19219 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} + module GitHub.Data.Statuses where import GitHub.Data.Definitions @@ -21,7 +19,7 @@ data StatusState | StatusSuccess | StatusError | StatusFailure - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData StatusState instance Binary StatusState @@ -52,7 +50,7 @@ data Status = Status , statusContext :: !(Maybe Text) , statusCreator :: !(Maybe SimpleUser) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON Status where parseJSON = withObject "Status" $ \o -> Status @@ -73,7 +71,7 @@ data NewStatus = NewStatus , newStatusDescription :: !(Maybe Text) , newStatusContext :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewStatus instance Binary NewStatus @@ -99,7 +97,7 @@ data CombinedStatus = CombinedStatus , combinedStatusCommitUrl :: !URL , combinedStatusUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON CombinedStatus where parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 4f3da777..01b1429c 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} module GitHub.Data.Teams where @@ -18,7 +15,7 @@ import qualified Data.Text as T data Privacy = PrivacyClosed | PrivacySecret - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData Privacy instance Binary Privacy @@ -27,7 +24,7 @@ data Permission = PermissionPull | PermissionPush | PermissionAdmin - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData Permission instance Binary Permission @@ -35,7 +32,7 @@ instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission { addTeamRepoPermission :: !Permission } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData AddTeamRepoPermission instance Binary AddTeamRepoPermission @@ -51,7 +48,7 @@ data SimpleTeam = SimpleTeam , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleTeam instance Binary SimpleTeam @@ -70,7 +67,7 @@ data Team = Team , teamReposCount :: !Int , teamOrganization :: !SimpleOrganization } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Team instance Binary Team @@ -82,7 +79,7 @@ data CreateTeam = CreateTeam , createTeamPrivacy :: !Privacy , createTeamPermission :: !Permission } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateTeam instance Binary CreateTeam @@ -93,7 +90,7 @@ data EditTeam = EditTeam , editTeamPrivacy :: !(Maybe Privacy) , editTeamPermission :: !(Maybe Permission) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData EditTeam instance Binary EditTeam @@ -101,7 +98,7 @@ instance Binary EditTeam data Role = RoleMaintainer | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Role instance Binary Role @@ -109,7 +106,7 @@ instance Binary Role data ReqState = StatePending | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData ReqState instance Binary ReqState @@ -119,14 +116,14 @@ data TeamMembership = TeamMembership , teamMembershipRole :: !Role , teamMembershipReqState :: !ReqState } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) 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 instance Binary CreateTeamMembership @@ -254,4 +251,4 @@ 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 c3d9edcc..69ddde70 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -10,7 +10,7 @@ import Prelude () -- -- /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 diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 32e97287..7d2bac40 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -20,7 +20,7 @@ data RepoWebhook = RepoWebhook , repoWebhookUpdatedAt :: !UTCTime , repoWebhookCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoWebhook instance Binary RepoWebhook @@ -85,7 +85,7 @@ data RepoWebhookEvent | WebhookWatchEvent | WebhookWorkflowDispatch | WebhookWorkflowRun - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoWebhookEvent instance Binary RepoWebhookEvent @@ -95,7 +95,7 @@ data RepoWebhookResponse = RepoWebhookResponse , repoWebhookResponseStatus :: !(Maybe Text) , repoWebhookResponseMessage :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoWebhookResponse instance Binary RepoWebhookResponse @@ -105,7 +105,7 @@ data PingEvent = PingEvent , pingEventHook :: !RepoWebhook , pingEventHookId :: !(Id RepoWebhook) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PingEvent instance Binary PingEvent @@ -116,7 +116,7 @@ data NewRepoWebhook = NewRepoWebhook , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , newRepoWebhookActive :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData NewRepoWebhook instance Binary NewRepoWebhook @@ -128,7 +128,7 @@ data EditRepoWebhook = EditRepoWebhook , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookActive :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData EditRepoWebhook instance Binary EditRepoWebhook diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 03a38b13..a001da65 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -13,7 +13,7 @@ import Data.Aeson as X 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, Typeable) +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) From 0c07f9e17076dfd67fe82d0b5cada98d961964a9 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:56:31 +0200 Subject: [PATCH 307/309] Bump to v0.30.0.1 and CHANGELOG, bump Haskell CI to 9.14 alpha1 --- .github/workflows/haskell-ci.yml | 57 ++++++++++++++++++++++++++++---- CHANGELOG.md | 9 +++++ github.cabal | 3 +- samples/github-samples.cabal | 1 + 4 files changed, 62 insertions(+), 8 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index bb4e2c16..b6ee1af9 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20250506 +# version: 0.19.20250821 # -# REGENDATA ("0.19.20250506",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20250821",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,6 +32,11 @@ jobs: 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 @@ -105,8 +110,8 @@ jobs: chmod a+x "$HOME/.ghcup/bin/ghcup" - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + "$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: | @@ -121,6 +126,21 @@ jobs: 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 @@ -131,7 +151,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$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 }} @@ -159,6 +179,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> 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" >> 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" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> 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 diff --git a/CHANGELOG.md b/CHANGELOG.md index 45c00f5a..014e7e29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## Changes for 0.30.0.1 + +_2025-08-27, Andreas Abel_ + +- Drop dependencies `deepseq-generics` and `transformers-compat`. +- Remove obsolete `deriving Typeable`. + +Tested with GHC 8.2 - 9.14 alpha1. + ## Changes for 0.30 _2025-05-09, Andreas Abel, Peace edition_ diff --git a/github.cabal b/github.cabal index 54f0d2a1..759c9f95 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: github -version: 0.30 +version: 0.30.0.1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -30,6 +30,7 @@ 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 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 2fd3287a..d58512a7 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,6 +10,7 @@ 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 From 4adbc91b2192eb5d6b1c7c59552d93cfa6ddfca4 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 15:59:20 +0200 Subject: [PATCH 308/309] Silence -Wincomplete-uni-patterns in testsuite (for Haskell CI) --- spec/GitHub/ReposSpec.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index 45c32415..9ccc7066 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,4 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} + +#if __GLASGOW_HASKELL__ >= 900 +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +#endif + module GitHub.ReposSpec where import GitHub From e42e78961099e80cb18d05386b574e4bc87187d2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 16:19:56 +0200 Subject: [PATCH 309/309] Haskell CI: turn of -Werror=unused-packages; hopeless for github-samples --- .github/workflows/haskell-ci.yml | 4 ---- cabal.haskell-ci | 5 +++++ samples/github-samples.cabal | 1 - 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b6ee1af9..2e003f87 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -246,10 +246,6 @@ jobs: 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 >= 90400)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> 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 diff --git a/cabal.haskell-ci b/cabal.haskell-ci index ccddf4a2..e44b77d2 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -3,6 +3,11 @@ 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 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index d58512a7..2e7a8699 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -29,7 +29,6 @@ library build-depends: , base >=4.11 && <5 -- require base-4.11 because then (<>) is in Prelude - , base-compat-batteries , github , text