github-0.20/0000755000000000000000000000000013352724157011114 5ustar0000000000000000github-0.20/CHANGELOG.md0000644000000000000000000001316013352724157012726 0ustar0000000000000000## Changes for 0.20 - Add ratelimit endpoint [#315](https://github.com/phadej/github/pull/315) - Add some deployment endoints [#330](https://github.com/phadej/github/pull/330) - Add webhook installation events [#329](https://github.com/phadej/github/pull/330) - Tigthen lower bounds (also remove aeson-compat dep) [#332](https://github.com/phadej/github/pull/332) ## Changes for 0.19 - Fix issue event type enumeration [#301](https://github.com/phadej/github/issues/301) - Include label info in `IssseEvent` [#302](https://github.com/phadej/github/issues/302) - Fix `ShowRepo` example [#306](https://github.com/phadej/github/pull/306) - Add "Get archive link" API [#307](https://github.com/phadej/github/pull/307) - Make "repo" in PullRequestCommit nullable (repository can be gone) [#311](https://github.com/phadej/github/pull/311) - Add read-only emails endpoint [#313](https://github.com/phadej/github/pull/313) - Organisation membership API [#312](https://github.com/phadej/github/pull/312) - Fix isPullRequestMerged and other boolean responses [#312](https://github.com/phadej/github/pull/312) - Add `behind` pull request mergeable state [#308](https://github.com/phadej/github/pull/308) - Add list organisation invitations endpoint ## Changes for 0.18 - Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) - Endpoints for (un)starring gists. [#296](https://github.com/phadej/github/pull/296) - Add `archived` field to `Repo`. [#298](https://github.com/phadej/github/pull/298) - Update dependencies. [#295](https://github.com/phadej/github/pull/295) - Add Statuses endpoints. [#268](https://github.com/phadej/github/pull/268) - Add requested reviewers field to pull request records. [#292](https://github.com/phadej/github/pull/292) ## Changes for 0.17.0 - Add `Ord Request` instance - Repository contents - Repository starring endpoints - Pull Request review endpoints ## Changes for 0.16.0 - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies - user events - release endpoints - forkExistingRepo ## Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering - GHC-8.0.1 support - Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` - Add `listTeamReposR` - Add `myStarredAcceptStarR` - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` - Add 'userIssuesR' - Add 'organizationIssuesR' - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` - Refactor 'Request' structure - Added multiple issue assignees - Preliminary support for repository events: `repositoryEventsR` - Support for adding repository permissions to the team - Remove 'simpleUserType', it was always the same. See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) ## Changes for 0.14.1 - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` - Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, `RepoPublicity` - Don't require network access for search tests ## Changes for 0.14.0 Large API changes: - Use `Text` and `Vector` in place of `String` and `[]`. - Use `Name` and `Id` tagged types for names and identifiers. - Make detailed structures un-prefixed, simple ones prefixed with `Simple`. Example: `Team` and `SimpleTeam`. - Decouple request creation from execution (`*R` and `executeRequest*` functions). - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. ## Changes for 0.5.0: * OAuth. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. * Relax the attoparsec version requirements. * The above by [John Wiegley](https://github.com/jwiegley). ## Changes for 0.4.1: * Stop using the uri package. * Use aeson version 0.6.1.0. * Use attoparsec version 0.10.3.0. * Use http-conduit over 1.8. * Use unordered-containers between 0.2 and 0.3. ## Changes for 0.4.0: * Use http-conduit version 1.4.1.10. ## Changes for 0.3.0: * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. * Add `deleteRepo`, `editRepo`, and `createRepo`. * Private gists, issues, organizations, pull requests, and users. * Lock down `tls` and `tls-extra` instead of keeping up with the ever-changing `http-conduit` package. * Features by [Pavel Ryzhov](https://github.com/paulrzcz) and [Simon Hengel](https://github.com/sol). ## Changes for 0.2.1: * Expand the unordered-containers dependency to anything in 0.1.x . ## Changes for 0.2.0: * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names * Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names * An `HTTPConnectionError` now composes `SomeException` instead of `IOException`. All exceptions raised by the underlying http-conduit library are encapulated there. * The `githubIssueClosedBy` function now produces a `Maybe GithubOwner`. * Remove the Blobs API, as it is broken upstream. * Bugs found and squashed thanks to [Joey Hess](https://github.com/joeyh) and [Simon Hengel](https://github.com/sol). github-0.20/LICENSE0000644000000000000000000000275513352724157012132 0ustar0000000000000000Copyright (c)2011, Mike Burns All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Mike Burns nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. github-0.20/github.cabal0000644000000000000000000001441713352724157013371 0ustar0000000000000000name: github version: 0.20 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full GitHub Web site, from Issues to Gists to repos down to the underlying git data like references and trees. This library wraps all of that, exposing a basic but Haskell-friendly set of functions and data structures. . For supported endpoints see "GitHub" module. . > import qualified GitHub as GH > > main :: IO () > main = do > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" > print possibleUser . For more of an overview please see the README: license: BSD3 license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus maintainer: Oleg Grenrus homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 cabal-version: >=1.10 extra-source-files: README.md, CHANGELOG.md, fixtures/issue-search.json, fixtures/list-teams.json, fixtures/members-list.json, fixtures/pull-request-opened.json, fixtures/pull-request-review-requested.json, fixtures/user-organizations.json, fixtures/user.json source-repository head type: git location: git://github.com/phadej/github.git 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 StandaloneDeriving RecordWildCards exposed-modules: GitHub GitHub.Internal.Prelude GitHub.Auth GitHub.Data GitHub.Data.Activities GitHub.Data.Comments GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys GitHub.Data.Deployments GitHub.Data.Email GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Invitation GitHub.Data.Issues GitHub.Data.Milestone GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests GitHub.Data.RateLimit GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Reviews GitHub.Data.Search GitHub.Data.Statuses GitHub.Data.Teams GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments GitHub.Endpoints.GitData.Blobs GitHub.Endpoints.GitData.Commits GitHub.Endpoints.GitData.References GitHub.Endpoints.GitData.Trees GitHub.Endpoints.Issues GitHub.Endpoints.Issues.Comments GitHub.Endpoints.Issues.Events GitHub.Endpoints.Issues.Labels GitHub.Endpoints.Issues.Milestones GitHub.Endpoints.Organizations GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.Comments GitHub.Endpoints.RateLimit GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Contents GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers 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 -- 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, byteable >=0.1.1 && <0.2, 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.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 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 GitHub.EventsSpec GitHub.IssuesSpec GitHub.OrganizationsSpec GitHub.PullRequestReviewsSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec main-is: Spec.hs ghc-options: -Wall 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 >= 2.5.6 && <2.6 github-0.20/Setup.hs0000644000000000000000000000005613352724157012551 0ustar0000000000000000import Distribution.Simple main = defaultMain github-0.20/README.md0000644000000000000000000000575213352724157012404 0ustar0000000000000000Github ------ [![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) [![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] [![Stackage LTS 5](http://stackage.org/package/github/badge/lts-5)](http://stackage.org/lts-5/package/github) [![Stackage Nightly](http://stackage.org/package/github/badge/nightly)](http://stackage.org/nightly/package/github) The Github API v3 for Haskell. Some functions are missing; these are functions where the Github API did not work as expected. The full Github API is in beta and constantly improving. Installation ============ In your project's cabal file: ```cabal -- Packages needed in order to build this package. Build-depends: github ``` Or from the command line: ```sh cabal install github ``` Example Usage ============= See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory. Documentation ============= For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). Request functions (ending with `R`) construct a data type with can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` module. IO functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: Many function have samples under [`samples/`](https://github.com/phadej/github/tree/master/samples) directory. ```hs {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} import Prelude.Compat import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) import Data.Monoid ((<>)) import qualified GitHub.Endpoints.Users.Followers as GitHub main :: IO () main = do possibleUsers <- GitHub.usersFollowing "mike-burns" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers formatUser :: GitHub.SimpleUser -> Text formatUser = GitHub.untagName . GitHub.simpleUserLogin ``` Test setup ========== To run integration part of tests, you'll need [github access token](https://github.com/settings/tokens/new) Token is needed, because unauthorised access is highly limited. It's enough to add only basic read access for public information. With `travis encrypt --org --repo yournick/github "GITHUB_TOKEN=yourtoken"` command you get a secret, you can use in your travis setup to run the test-suite there. Contributions ============= Please see [CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) for details on how you can help. Copyright ========= Copyright 2011-2012 Mike Burns. Copyright 2013-2015 John Wiegley. Copyright 2016 Oleg Grenrus. Available under the BSD 3-clause license. [hackage]: http://hackage.haskell.org/package/github "Hackage" github-0.20/src/0000755000000000000000000000000013352724156011702 5ustar0000000000000000github-0.20/src/GitHub.hs0000644000000000000000000002364213352724156013427 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module re-exports all request constructrors and data definitions from -- this package. -- -- See "GitHub.Request" module for executing 'Request', or other modules -- of this package (e.g. "GitHub.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. module GitHub ( -- * Activity -- | See -- ** Events -- | See https://developer.github.com/v3/activity/events/#events repositoryEventsR, userEventsR, -- ** Starring -- | See -- -- Missing endpoints: -- -- * Check if you are starring a repository stargazersForR, reposStarredByR, myStarredR, myStarredAcceptStarR, starRepoR, unstarRepoR, -- ** Watching -- | See -- -- Missing endpoints: -- -- * Query a Repository Subscription -- * Set a Repository Subscription -- * Delete a Repository Subscription watchersForR, reposWatchedByR, -- * Gists -- | See -- -- Missing endpoints: -- -- * Query a specific revision of a gist -- * Create a gist -- * Edit a gist -- * List gist commits -- * Check if a gist is starred -- * Fork a gist -- * List gist forks gistsR, gistR, starGistR, unstarGistR, deleteGistR, -- ** Comments -- | See -- -- Missing endpoints: -- * Create a comment -- * Edit a comment -- * Delete a comment commentsOnR, gistCommentR, -- * Git Data -- | See -- ** Blobs -- | See blobR, -- ** Commits -- | See gitCommitR, -- ** References -- | See referenceR, referencesR, createReferenceR, -- ** Trees -- | See treeR, nestedTreeR, -- * Issues -- | See -- currentUserIssuesR, organizationIssuesR, issueR, issuesForRepoR, createIssueR, editIssueR, -- ** Comments -- | See -- commentR, commentsR, createCommentR, deleteCommentR, editCommentR, -- ** Events -- | See -- eventsForIssueR, eventsForRepoR, eventR, -- ** Labels -- | See -- labelsOnRepoR, labelR, createLabelR, updateLabelR, deleteLabelR, labelsOnIssueR, addLabelsToIssueR, removeLabelFromIssueR, replaceAllLabelsForIssueR, removeAllLabelsFromIssueR, labelsOnMilestoneR, -- ** Milestone -- | See -- -- Missing endpoints: -- -- * Create a milestone -- * Update a milestone -- * Delete a milestone milestonesR, milestoneR, -- * Organizations -- | See -- -- Missing endpoints: -- -- * List your organizations -- * List all organizations -- * Edit an organization publicOrganizationsForR, publicOrganizationR, -- ** Members -- | See -- -- Missing endpoints: All except /Members List/ and /Check Membership/ membersOfR, membersOfWithR, isMemberOfR, orgInvitationsR, -- ** Teams -- | See -- -- Missing endpoints: -- -- * Query team member (deprecated) -- * Add team member (deprecated) -- * Remove team member (deprecated) -- * Check if a team manages a repository -- * Add team repository -- * Remove team repository teamsOfR, teamInfoForR, createTeamForR, editTeamR, deleteTeamR, listTeamMembersR, listTeamReposR, teamMembershipInfoForR, addTeamMembershipForR, deleteTeamMembershipForR, listTeamsCurrentR, -- * Pull Requests -- | See pullRequestsForR, pullRequestR, createPullRequestR, updatePullRequestR, pullRequestCommitsR, pullRequestFilesR, isPullRequestMergedR, mergePullRequestR, -- ** Review comments -- | See -- -- Missing endpoints: -- -- * List comments in a repository -- * Create a comment -- * Edit a comment -- * Delete a comment pullRequestCommentsR, pullRequestCommentR, -- ** Pull request reviews -- | See -- -- Missing endpoints: -- -- * Delete a pending review -- * Create a pull request review -- * Submit a pull request review -- * Dismiss a pull request review pullRequestReviewsR, pullRequestReviews, pullRequestReviews', pullRequestReviewR, pullRequestReview, pullRequestReview', pullRequestReviewCommentsR, pullRequestReviewCommentsIO, pullRequestReviewCommentsIO', -- * Repositories -- | See -- -- Missing endpoints: -- -- * List all public repositories -- * List Teams -- * Query Branch -- * Enabling and disabling branch protection currentUserReposR, userReposR, organizationReposR, repositoryR, contributorsR, languagesForR, tagsForR, branchesForR, -- ** Collaborators -- | See collaboratorsOnR, isCollaboratorOnR, -- ** Comments -- | See -- -- Missing endpoints: -- -- * Create a commit comment -- * Update a commit comment -- * Delete a commit comment commentsForR, commitCommentsForR, commitCommentForR, -- ** Commits -- | See commitsForR, commitsWithOptionsForR, commitR, diffR, -- ** Deployments -- | See -- -- Missing endpoints: -- * Get a single deployment -- * Update a deployment -- * Get a single deployment status deploymentsWithOptionsForR, createDeploymentR, deploymentStatusesForR, createDeploymentStatusR, -- ** Forks -- | See -- -- Missing endpoints: -- -- * Create a fork forksForR, -- ** Webhooks -- | See webhooksForR, webhookForR, createRepoWebhookR, editRepoWebhookR, testPushRepoWebhookR, pingRepoWebhookR, deleteRepoWebhookR, -- * Releases releasesR, releaseR, latestReleaseR, releaseByTagNameR, -- * Search -- | See -- -- Missing endpoints: -- -- * Search users searchReposR, searchCodeR, searchIssuesR, -- * Users -- | See -- -- Missing endpoints: -- -- * Update the authenticated user -- * Query all users userInfoForR, ownerInfoForR, userInfoCurrentR, -- ** Emails -- | See -- -- Missing endpoints: -- -- * Add email address(es) -- * Delete email address(es) -- * Toggle primary email visibility currentUserEmailsR, currentUserPublicEmailsR, -- ** Followers -- | See -- -- Missing endpoints: -- -- * Check if you are following a user -- * Check if one user follows another -- * Follow a user -- * Unfollow a user usersFollowingR, usersFollowedByR, -- ** Statuses -- | See createStatusR, statusesForR, statusForR, -- ** Rate Limit -- | See rateLimitR, -- * Data definitions module GitHub.Data, -- * Request handling module GitHub.Request, ) where import GitHub.Data import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists import GitHub.Endpoints.Gists.Comments import GitHub.Endpoints.GitData.Blobs import GitHub.Endpoints.GitData.Commits import GitHub.Endpoints.GitData.References import GitHub.Endpoints.GitData.Trees import GitHub.Endpoints.Issues import GitHub.Endpoints.Issues.Comments import GitHub.Endpoints.Issues.Events import GitHub.Endpoints.Issues.Labels import GitHub.Endpoints.Issues.Milestones import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users import GitHub.Endpoints.Users.Emails import GitHub.Endpoints.Users.Followers import GitHub.Request github-0.20/src/GitHub/0000755000000000000000000000000013352724157013065 5ustar0000000000000000github-0.20/src/GitHub/Request.hs0000644000000000000000000003366113352724157015062 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module provides data types and helper methods, which makes possible -- to build alternative API request intepreters in addition to provided -- 'IO' functions. -- -- Simple example using @operational@ package. See @samples\/Operational\/Operational.hs@ -- -- > type GithubMonad a = Program (GH.Request 'False) a -- > -- > -- | Intepret GithubMonad value into IO -- > runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a -- > runMonad mgr auth m = case view m of -- > Return a -> return a -- > req :>>= k -> do -- > b <- ExceptT $ GH.executeRequestWithMgr mgr auth req -- > runMonad mgr auth (k b) -- > -- > -- | Lift request into Monad -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( -- * Types Request(..), CommandMethod(..), toMethod, Paths, QueryString, -- * Request execution in IO executeRequest, executeRequestWithMgr, executeRequest', executeRequestWithMgr', executeRequestMaybe, unsafeDropAuthRequirements, -- * Helpers makeHttpRequest, makeHttpSimpleRequest, parseResponse, parseStatus, getNextUrl, performPagedRequest, ) where import GitHub.Internal.Prelude import Prelude () import Control.Monad.Error.Class (MonadError (..)) import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), 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, parseURIReference, relativeTo) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP import GitHub.Auth (Auth (..)) import GitHub.Data (Error (..)) import GitHub.Data.Request -- | Execute 'Request' in 'IO' executeRequest :: Auth -> Request k a -> IO (Either Error a) executeRequest auth req = 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 :: Manager -> Auth -> Request k a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req performHttpReq httpReq req where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException performHttpReq :: HTTP.Request -> Request k b -> ExceptT Error IO b performHttpReq httpReq (SimpleQuery sreq) = performHttpReq' httpReq sreq performHttpReq httpReq (HeaderQuery _ sreq) = performHttpReq' httpReq sreq performHttpReq httpReq (StatusQuery sm _) = do res <- httpLbs' httpReq parseStatus sm . responseStatus $ res performHttpReq httpReq (RedirectQuery _) = do res <- httpLbs' httpReq parseRedirect (getUri httpReq) 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 () Put' -> pure () _ -> parseResponse res -- | Like 'executeRequest' but without authentication. executeRequest' ::Request '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 -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ do httpReq <- makeHttpRequest Nothing req performHttpReq httpReq req where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException performHttpReq :: HTTP.Request -> Request 'RO b -> ExceptT Error IO b performHttpReq httpReq (SimpleQuery sreq) = performHttpReq' httpReq sreq performHttpReq httpReq (HeaderQuery _ sreq) = performHttpReq' httpReq sreq performHttpReq httpReq (StatusQuery sm _) = do res <- httpLbs' httpReq parseStatus sm . responseStatus $ res performHttpReq httpReq (RedirectQuery _) = do res <- httpLbs' httpReq parseRedirect (getUri httpReq) res performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b performHttpReq' httpReq Query {} = do res <- httpLbs' httpReq parseResponse res performHttpReq' httpReq (PagedQuery _ _ l) = performPagedRequest httpLbs' predicate httpReq where predicate v = lessFetchCount (V.length v) l -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. 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 (SimpleQuery (Query ps qs)) = SimpleQuery (Query ps qs) unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r ------------------------------------------------------------------------------ -- Tools ------------------------------------------------------------------------------ -- | Create @http-client@ 'Request'. -- -- * for 'PagedQuery', the initial request is created. -- * for 'Status', the 'Request' for underlying 'Request' is created, -- status checking is modifying accordingly. -- -- @ -- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' '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' <- makeHttpSimpleRequest auth req return $ setCheckStatus (Just sm) req' HeaderQuery h req -> do req' <- makeHttpSimpleRequest auth req return $ req' { requestHeaders = h <> requestHeaders req' } RedirectQuery req -> do req' <- makeHttpSimpleRequest auth req return $ setRequestIgnoreStatus $ req' { redirectCount = 0 } makeHttpSimpleRequest :: MonadThrow m => Maybe Auth -> SimpleRequest k a -> m HTTP.Request makeHttpSimpleRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths 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 where parseUrl' :: MonadThrow m => Text -> m HTTP.Request 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" setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } reqHeaders :: RequestHeaders reqHeaders = maybe [] getOAuthHeader auth <> [("User-Agent", "github.hs/0.7.4")] <> [("Accept", "application/vnd.github.preview")] 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 linkHeader <- lookup "Link" (responseHeaders req) links <- parseLinkHeaderBS linkHeader nextURI <- find isRelNext links return $ href nextURI where isRelNext :: Link -> Bool isRelNext = any (== relNextLinkParam) . linkParams relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") -- | 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. -- -- @ -- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) -- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) -- -> (a -> 'Bool') -- -> 'HTTP.Request' -- -> 'ExceptT' 'Error' 'IO' a -- @ performPagedRequest :: forall a m. (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 go m res initReq where go :: a -> Response LBS.ByteString -> HTTP.Request -> m a go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do req' <- HTTP.setUri req uri res' <- httpLbs' req' m <- parseResponse res' go (acc <> m) res' req' (_, _) -> return acc ------------------------------------------------------------------------------- -- 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 github-0.20/src/GitHub/Data.hs0000644000000000000000000000623213352724156014274 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules. module GitHub.Data ( -- * Tagged types -- ** Name Name, mkName, untagName, mkOwnerName, mkUserName, mkTeamName, mkOrganizationName, mkRepoName, mkCommitName, fromUserName, fromOrganizationName, -- ** Id Id, mkId, untagId, mkOwnerId, mkUserId, mkTeamId, mkOrganizationId, mkRepoId, fromUserId, fromOrganizationId, -- * Module re-exports module GitHub.Auth, module GitHub.Data.Activities, module GitHub.Data.Comments, module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, module GitHub.Data.Deployments, module GitHub.Data.Email, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Invitation, module GitHub.Data.Issues, module GitHub.Data.Milestone, module GitHub.Data.Options, module GitHub.Data.PullRequests, module GitHub.Data.RateLimit, module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Reviews, module GitHub.Data.Search, module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, module GitHub.Data.Webhooks ) where import GitHub.Internal.Prelude import Prelude () import GitHub.Auth import GitHub.Data.Activities import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys import GitHub.Data.Deployments import GitHub.Data.Email import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Invitation import GitHub.Data.Issues import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options import GitHub.Data.PullRequests import GitHub.Data.RateLimit import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Reviews import GitHub.Data.Search import GitHub.Data.Statuses import GitHub.Data.Teams import GitHub.Data.URL import GitHub.Data.Webhooks mkOwnerId :: Int -> Id Owner mkOwnerId = Id mkOwnerName :: Text -> Name Owner mkOwnerName = N mkUserId :: Int -> Id User mkUserId = Id mkUserName :: Text -> Name User mkUserName = N mkTeamId :: Int -> Id Team mkTeamId = Id mkTeamName :: Text -> Name Team mkTeamName = N mkOrganizationId :: Int -> Id Organization mkOrganizationId = Id mkOrganizationName :: Text -> Name Organization mkOrganizationName = N mkRepoId :: Int -> Id Repo mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N mkCommitName :: Text -> Name Commit mkCommitName = N fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName fromUserName :: Name User -> Name Owner fromUserName = N . untagName fromOrganizationId :: Id Organization -> Id Owner fromOrganizationId = Id . untagId fromUserId :: Id User -> Id Owner fromUserId = Id . untagId github-0.20/src/GitHub/Auth.hs0000644000000000000000000000131713352724156014323 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Auth where import GitHub.Internal.Prelude import Prelude () import qualified Data.ByteString as BS 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 deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Auth where rnf = genericRnf instance Binary Auth instance Hashable Auth github-0.20/src/GitHub/Internal/0000755000000000000000000000000013352724156014640 5ustar0000000000000000github-0.20/src/GitHub/Internal/Prelude.hs0000644000000000000000000000365613352724156016606 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module may change between minor releases. Do not rely on it contents. module GitHub.Internal.Prelude ( module Prelude.Compat, -- * Commonly used types UTCTime, HashMap, Text, pack, unpack, Vector, -- * Commonly used typeclasses Binary, Data, Typeable, Generic, Hashable(..), IsString(..), NFData(..), genericRnf, Semigroup(..), -- * Aeson FromJSON(..), ToJSON(..), Value(..), Object, encode, withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, -- * Control.Applicative (<|>), -- * Data.Maybe catMaybes, -- * Data.List intercalate, toList, -- * Data.Time.ISO8601 formatISO8601, ) where import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) import Data.Binary.Orphans () import Data.Data (Data, Typeable) import Data.Foldable (toList) import Data.Hashable (Hashable (..)) import Data.HashMap.Strict (HashMap) import Data.List (intercalate) import Data.Maybe (catMaybes) import Data.Semigroup (Semigroup (..)) import Data.String (IsString (..)) import Data.Text (Text, pack, unpack) import Data.Time (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) import Data.Vector.Instances () import GHC.Generics (Generic) import Prelude.Compat github-0.20/src/GitHub/Data/0000755000000000000000000000000013352724157013736 5ustar0000000000000000github-0.20/src/GitHub/Data/Content.hs0000644000000000000000000001450613352724156015711 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- 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 () data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Content where rnf = genericRnf instance Binary Content data ContentFileData = ContentFileData { contentFileInfo :: !ContentInfo ,contentFileEncoding :: !Text ,contentFileSize :: !Int ,contentFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentFileData where rnf = genericRnf instance Binary ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { contentItemType :: !ContentItemType ,contentItemInfo :: !ContentInfo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItem where rnf = genericRnf instance Binary ContentItem data ContentItemType = ItemFile | ItemDir deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItemType where rnf = genericRnf instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { contentName :: !Text ,contentPath :: !Text ,contentSha :: !Text ,contentUrl :: !URL ,contentGitUrl :: !URL ,contentHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo data ContentResultInfo = ContentResultInfo { contentResultInfo :: !ContentInfo , contentResultSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentResultInfo where rnf = genericRnf instance Binary ContentResultInfo data ContentResult = ContentResult { contentResultContent :: !ContentResultInfo , contentResultCommit :: !GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentResult where rnf = genericRnf instance Binary ContentResult data Author = Author { authorName :: !Text , authorEmail :: !Text } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData Author where rnf = genericRnf instance Binary Author data CreateFile = CreateFile { createFilePath :: !Text , createFileMessage :: !Text , createFileContent :: !Text , createFileBranch :: !(Maybe Text) , createFileAuthor :: !(Maybe Author) , createFileCommitter :: !(Maybe Author) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData CreateFile where rnf = genericRnf instance Binary CreateFile data UpdateFile = UpdateFile { updateFilePath :: !Text , updateFileMessage :: !Text , updateFileContent :: !Text , updateFileSHA :: !Text , updateFileBranch :: !(Maybe Text) , updateFileAuthor :: !(Maybe Author) , updateFileCommitter :: !(Maybe Author) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData UpdateFile where rnf = genericRnf instance Binary UpdateFile data DeleteFile = DeleteFile { deleteFilePath :: !Text , deleteFileMessage :: !Text , deleteFileSHA :: !Text , deleteFileBranch :: !(Maybe Text) , deleteFileAuthor :: !(Maybe Author) , deleteFileCommitter :: !(Maybe Author) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData DeleteFile where rnf = genericRnf instance Binary DeleteFile instance FromJSON Content where parseJSON o@(Object _) = ContentFile <$> parseJSON o parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os parseJSON _ = fail "Could not build a Content" instance FromJSON ContentFileData where parseJSON = withObject "ContentFileData" $ \o -> ContentFileData <$> parseJSON (Object o) <*> o .: "encoding" <*> o .: "size" <*> o .: "content" instance FromJSON ContentItem where parseJSON = withObject "ContentItem" $ \o -> ContentItem <$> o .: "type" <*> parseJSON (Object o) instance FromJSON ContentItemType where parseJSON = withText "ContentItemType" $ \t -> case t of "file" -> return ItemFile "dir" -> return ItemDir _ -> fail $ "Invalid ContentItemType: " ++ unpack t instance FromJSON ContentInfo where parseJSON = withObject "ContentInfo" $ \o -> ContentInfo <$> o .: "name" <*> o .: "path" <*> o .: "sha" <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" instance FromJSON ContentResultInfo where parseJSON = withObject "ContentResultInfo" $ \o -> ContentResultInfo <$> parseJSON (Object o) <*> o .: "size" instance FromJSON ContentResult where parseJSON = withObject "ContentResult" $ \o -> ContentResult <$> o .: "content" <*> o .: "commit" instance ToJSON Author where toJSON Author {..} = object [ "name" .= authorName , "email" .= authorEmail ] instance ToJSON CreateFile where toJSON CreateFile {..} = object $ [ "path" .= createFilePath , "message" .= createFileMessage , "content" .= createFileContent ] ++ "branch" .=? createFileBranch ++ "author" .=? createFileAuthor ++ "committer" .=? createFileCommitter instance ToJSON UpdateFile where toJSON UpdateFile {..} = object $ [ "path" .= updateFilePath , "message" .= updateFileMessage , "content" .= updateFileContent , "sha" .= updateFileSHA ] ++ "branch" .=? updateFileBranch ++ "author" .=? updateFileAuthor ++ "committer" .=? updateFileCommitter instance ToJSON DeleteFile where toJSON DeleteFile {..} = object $ [ "path" .= deleteFilePath , "message" .= deleteFileMessage , "sha" .= deleteFileSHA ] ++ "branch" .=? deleteFileBranch ++ "author" .=? deleteFileAuthor ++ "committer" .=? deleteFileCommitter (.=?) :: ToJSON v => Text -> Maybe v -> [Pair] name .=? value = maybe [] (pure . (name .=)) value github-0.20/src/GitHub/Data/Request.hs0000644000000000000000000002136613352724157015732 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Request ( -- * Request Request (..), SimpleRequest (..), -- * Smart constructors query, pagedQuery, command, -- * Auxiliary types RW(..), StatusMap, statusOnlyOk, CommandMethod(..), toMethod, FetchCount(..), Paths, IsPathPart(..), QueryString, Count, ) where 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 import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method import Network.URI (URI) ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ type Paths = [Text] class IsPathPart a where toPathPart :: a -> Text instance IsPathPart (Name a) where toPathPart = untagName instance IsPathPart (Id a) where toPathPart = T.pack . show . untagId -- | Http method of requests with body. data CommandMethod a where Post :: CommandMethod a Patch :: CommandMethod a Put :: CommandMethod a Put' :: CommandMethod () Delete :: CommandMethod () deriving (Typeable) 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 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 -- many pages we want to fetch. data FetchCount = FetchAtLeast !Word | FetchAll deriving (Eq, Ord, Read, Show, Generic, Typeable) -- | This instance is there mostly for 'fromInteger'. instance Num FetchCount where fromInteger = FetchAtLeast . fromInteger FetchAtLeast a + FetchAtLeast b = FetchAtLeast (a * b) _ + _ = FetchAll FetchAtLeast a * FetchAtLeast b = FetchAtLeast (a * b) _ * _ = FetchAll abs = error "abs @FetchCount: not implemented" signum = error "signum @FetchCount: not implemented" negate = error "negate @FetchCount: not implemented" instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf ------------------------------------------------------------------------------ -- 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 :: RW) a where SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a RedirectQuery :: SimpleRequest k () -> Request k URI deriving (Typeable) data SimpleRequest (k :: RW) a where Query :: Paths -> QueryString -> SimpleRequest k a PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a) Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a deriving (Typeable) ------------------------------------------------------------------------------- -- Status Map ------------------------------------------------------------------------------- -- TODO: Change to 'Map' ? type StatusMap a = [(Int, a)] statusOnlyOk :: StatusMap Bool statusOnlyOk = [ (204, 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) 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 hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps `hashWithSalt` qs hashWithSalt salt (PagedQuery ps qs l) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` ps `hashWithSalt` qs `hashWithSalt` l hashWithSalt salt (Command m ps body) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body 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 github-0.20/src/GitHub/Data/Events.hs0000644000000000000000000000154113352724156015536 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Events where import GitHub.Data.Definitions import GitHub.Internal.Prelude import Prelude () -- | Events. -- -- /TODO:/ -- -- * missing repo, org, payload, id data Event = Event -- { eventId :: !(Id Event) -- id can be encoded as string. { eventActor :: !SimpleUser , eventCreatedAt :: !UTCTime , eventPublic :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf instance Binary Event instance FromJSON Event where parseJSON = withObject "Event" $ \obj -> Event -- <$> obj .: "id" <$> obj .: "actor" <*> obj .: "created_at" <*> obj .: "public" github-0.20/src/GitHub/Data/URL.hs0000644000000000000000000000127113352724157014735 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.URL ( URL(..), getUrl, ) where import GitHub.Internal.Prelude import Prelude () -- | Data representing URLs in responses. -- -- /N.B./ syntactical validity is not verified. newtype URL = URL Text deriving (Eq, Ord, Show, Generic, Typeable, Data) getUrl :: URL -> Text getUrl (URL url) = url instance NFData URL where rnf = genericRnf instance Binary URL instance ToJSON URL where toJSON (URL url) = toJSON url instance FromJSON URL where parseJSON = withText "URL" (pure . URL) github-0.20/src/GitHub/Data/Gists.hs0000644000000000000000000000515113352724156015364 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Gists where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Language) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Gist = Gist { gistUser :: !SimpleUser , gistGitPushUrl :: !URL , gistUrl :: !URL , gistDescription :: !(Maybe Text) , gistCreatedAt :: !UTCTime , gistPublic :: !Bool , gistComments :: !Int , gistUpdatedAt :: !UTCTime , gistHtmlUrl :: !URL , gistId :: !(Name Gist) , gistFiles :: !(HashMap Text GistFile) , gistGitPullUrl :: !URL } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf instance Binary Gist instance FromJSON Gist where parseJSON = withObject "Gist" $ \o -> Gist <$> o .: "owner" <*> o .: "git_push_url" <*> o .: "url" <*> o .:? "description" <*> o .: "created_at" <*> o .: "public" <*> o .: "comments" <*> o .: "updated_at" <*> o .: "html_url" <*> o .: "id" <*> o .: "files" <*> o .: "git_push_url" data GistFile = GistFile { gistFileType :: !Text , gistFileRawUrl :: !URL , gistFileSize :: !Int , gistFileLanguage :: !(Maybe Language) , gistFileFilename :: !Text , gistFileContent :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Generic) instance NFData GistFile where rnf = genericRnf instance Binary GistFile instance FromJSON GistFile where parseJSON = withObject "GistFile" $ \o -> GistFile <$> o .: "type" <*> o .: "raw_url" <*> o .: "size" <*> o .:? "language" <*> o .: "filename" <*> o .:? "content" data GistComment = GistComment { gistCommentUser :: !SimpleUser , gistCommentUrl :: !URL , gistCommentCreatedAt :: !UTCTime , gistCommentBody :: !Text , gistCommentUpdatedAt :: !UTCTime , gistCommentId :: !(Id GistComment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment where rnf = genericRnf instance Binary GistComment instance FromJSON GistComment where parseJSON = withObject "GistComment" $ \o -> GistComment <$> o .: "user" <*> o .: "url" <*> o .: "created_at" <*> o .: "body" <*> o .: "updated_at" <*> o .: "id" github-0.20/src/GitHub/Data/Webhooks.hs0000644000000000000000000002014613352724157016056 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Map as M 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 | WebhookInstallationEvent | WebhookInstallationRepositoriesEvent | 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) instance NFData RepoWebhookResponse where rnf = genericRnf instance Binary RepoWebhookResponse data PingEvent = PingEvent { pingEventZen :: !Text , pingEventHook :: !RepoWebhook , pingEventHookId :: !(Id RepoWebhook) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent where rnf = genericRnf instance Binary PingEvent data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: !Text , newRepoWebhookConfig :: !(M.Map Text Text) , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , newRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData NewRepoWebhook where rnf = genericRnf instance Binary NewRepoWebhook data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) , editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData EditRepoWebhook where rnf = genericRnf instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where parseJSON (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 "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 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 WebhookInstallationEvent = String "installation" toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" 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" instance FromJSON RepoWebhookResponse where parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse <$> o .: "code" <*> o .: "status" <*> o .: "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name , newRepoWebhookConfig = config , newRepoWebhookEvents = events , newRepoWebhookActive = active }) = object [ "name" .= name , "config" .= config , "events" .= events , "active" .= active ] instance ToJSON EditRepoWebhook where toJSON (EditRepoWebhook { editRepoWebhookConfig = config , editRepoWebhookEvents = events , editRepoWebhookAddEvents = addEvents , editRepoWebhookRemoveEvents = removeEvents , editRepoWebhookActive = active }) = object [ "config" .= config , "events" .= events , "add_events" .= addEvents , "remove_events" .= removeEvents , "active" .= active ] instance FromJSON PingEvent where parseJSON = withObject "PingEvent" $ \o -> PingEvent <$> o .: "zen" <*> o .: "hook" <*> o .: "hook_id" github-0.20/src/GitHub/Data/Reviews.hs0000644000000000000000000000564013352724157015723 0ustar0000000000000000module 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 () 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 { reviewCommentId :: !(Id ReviewComment) , reviewCommentUser :: !SimpleUser , reviewCommentBody :: !Text , reviewCommentUrl :: !URL , reviewCommentPullRequestReviewId :: !(Id Review) , reviewCommentDiffHunk :: !Text , reviewCommentPath :: !Text , reviewCommentPosition :: !Int , reviewCommentOriginalPosition :: !Int , reviewCommentCommitId :: !Text , reviewCommentOriginalCommitId :: !Text , reviewCommentCreatedAt :: !UTCTime , reviewCommentUpdatedAt :: !UTCTime , reviewCommentHtmlUrl :: !URL , reviewCommentPullRequestUrl :: !URL } deriving (Show, Generic) instance NFData ReviewComment where rnf = genericRnf instance Binary ReviewComment instance FromJSON ReviewComment where parseJSON = withObject "ReviewComment" $ \o -> ReviewComment <$> o .: "id" <*> o .: "user" <*> o .: "body" <*> o .: "url" <*> o .: "pull_request_review_id" <*> o .: "diff_hunk" <*> o .: "path" <*> o .: "position" <*> o .: "original_position" <*> o .: "commit_id" <*> o .: "original_commit_id" <*> o .: "created_at" <*> o .: "updated_at" <*> o .: "html_url" <*> o .: "pull_request_url" github-0.20/src/GitHub/Data/Milestone.hs0000644000000000000000000000241713352724157016235 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Milestone where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Milestone = Milestone { milestoneCreator :: !SimpleUser , milestoneDueOn :: !(Maybe UTCTime) , milestoneOpenIssues :: !Int , milestoneNumber :: !(Id Milestone) , milestoneClosedIssues :: !Int , milestoneDescription :: !(Maybe Text) , milestoneTitle :: !Text , milestoneUrl :: !URL , milestoneCreatedAt :: !UTCTime , milestoneState :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Milestone where rnf = genericRnf instance Binary Milestone instance FromJSON Milestone where parseJSON = withObject "Milestone" $ \o -> Milestone <$> o .: "creator" <*> o .: "due_on" <*> o .: "open_issues" <*> o .: "number" <*> o .: "closed_issues" <*> o .: "description" <*> o .: "title" <*> o .: "url" <*> o .: "created_at" <*> o .: "state" github-0.20/src/GitHub/Data/RateLimit.hs0000644000000000000000000000227713352724157016174 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () data Limits = Limits { limitsMax :: !Int , limitsRemaining :: !Int , limitsReset :: !Int -- TODO: change to proper type } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Limits where rnf = genericRnf instance Binary Limits instance FromJSON Limits where parseJSON = withObject "Limits" $ \obj -> Limits <$> obj .: "limit" <*> obj .: "remaining" <*> obj .: "reset" data RateLimit = RateLimit { rateLimitCore :: Limits , rateLimitSearch :: Limits , rateLimitGraphQL :: Limits } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RateLimit where rnf = genericRnf instance Binary RateLimit instance FromJSON RateLimit where parseJSON = withObject "RateLimit" $ \obj -> do resources <- obj .: "resources" RateLimit <$> resources .: "core" <*> resources .: "search" <*> resources .: "graphql" github-0.20/src/GitHub/Data/Comments.hs0000644000000000000000000000352213352724156016060 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Comments where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Comment = Comment { commentPosition :: !(Maybe Int) , commentLine :: !(Maybe Int) , commentBody :: !Text , commentCommitId :: !(Maybe Text) , commentUpdatedAt :: !UTCTime , commentHtmlUrl :: !(Maybe URL) , commentUrl :: !URL , commentCreatedAt :: !(Maybe UTCTime) , commentPath :: !(Maybe Text) , commentUser :: !SimpleUser , commentId :: !(Id Comment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment where rnf = genericRnf instance Binary Comment instance FromJSON Comment where parseJSON = withObject "Comment" $ \o -> Comment <$> o .:? "position" <*> o .:? "line" <*> o .: "body" <*> o .:? "commit_id" <*> o .: "updated_at" <*> o .:? "html_url" <*> o .: "url" <*> o .: "created_at" <*> o .:? "path" <*> o .: "user" <*> o .: "id" data NewComment = NewComment { newCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewComment where rnf = genericRnf instance Binary NewComment instance ToJSON NewComment where toJSON (NewComment b) = object [ "body" .= b ] data EditComment = EditComment { editCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditComment where rnf = genericRnf instance Binary EditComment instance ToJSON EditComment where toJSON (EditComment b) = object [ "body" .= b ] github-0.20/src/GitHub/Data/Statuses.hs0000644000000000000000000000630213352724157016106 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module GitHub.Data.Statuses where import GitHub.Data.Definitions import GitHub.Data.Name (Name) import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import GitHub.Data.GitData (Commit) import GitHub.Data.Repos (RepoRef) 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 :: !(Maybe SimpleUser) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON Status where parseJSON = withObject "Status" $ \o -> Status <$> o .: "created_at" <*> o .: "updated_at" <*> o .: "state" <*> o .:? "target_url" <*> o .:? "description" <*> o .: "id" <*> o .: "url" <*> o .:? "context" <*> o .:? "creator" data NewStatus = NewStatus { newStatusState :: !StatusState , newStatusTargetUrl :: !(Maybe URL) , newStatusDescription :: !(Maybe Text) , newStatusContext :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewStatus where rnf = genericRnf instance Binary NewStatus instance ToJSON NewStatus where toJSON (NewStatus s t d c) = object $ filter notNull $ [ "state" .= s , "target_url" .= t , "description" .= d , "context" .= c ] where notNull (_, Null) = False notNull (_, _) = True data CombinedStatus = CombinedStatus { combinedStatusState :: !StatusState , combinedStatusSha :: !(Name Commit) , combinedStatusTotalCount :: !Int , combinedStatusStatuses :: !(Vector Status) , combinedStatusRepository :: !RepoRef , combinedStatusCommitUrl :: !URL , combinedStatusUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON CombinedStatus where parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus <$> o .: "state" <*> o .: "sha" <*> o .: "total_count" <*> o .: "statuses" <*> o .: "repository" <*> o .: "commit_url" <*> o .: "url" github-0.20/src/GitHub/Data/Id.hs0000644000000000000000000000143213352724156014625 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Id ( Id(..), mkId, untagId, ) where import GitHub.Internal.Prelude import Prelude () -- | Numeric identifier. newtype Id entity = Id Int deriving (Eq, Ord, Show, Generic, Typeable, Data) -- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity mkId _ = Id untagId :: Id entity -> Int untagId (Id name) = name instance Hashable (Id entity) instance Binary (Id entity) instance NFData (Id entity) where rnf (Id s) = rnf s instance FromJSON (Id entity) where parseJSON = fmap Id . parseJSON instance ToJSON (Id entity) where toJSON = toJSON . untagId github-0.20/src/GitHub/Data/Name.hs0000644000000000000000000000236313352724157015156 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Name ( Name(..), mkName, untagName, ) where import Prelude () import GitHub.Internal.Prelude #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) #endif newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) -- | Smart constructor for 'Name' mkName :: proxy entity -> Text -> Name entity mkName _ = N untagName :: Name entity -> Text untagName (N name) = name instance Hashable (Name entity) instance Binary (Name entity) instance NFData (Name entity) where rnf (N s) = rnf s instance FromJSON (Name entity) where parseJSON = fmap N . parseJSON instance ToJSON (Name entity) where toJSON = toJSON . untagName instance IsString (Name entity) where fromString = N . fromString #if MIN_VERSION_aeson(1,0,0) -- | @since 0.15.0.0 instance ToJSONKey (Name entity) where toJSONKey = toJSONKeyText untagName -- | @since 0.15.0.0 instance FromJSONKey (Name entity) where fromJSONKey = fromJSONKeyCoerce #endif github-0.20/src/GitHub/Data/Issues.hs0000644000000000000000000002236013352724157015550 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Issues where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name) import GitHub.Data.Options (IssueState) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Issue = Issue { issueClosedAt :: !(Maybe UTCTime) , issueUpdatedAt :: !UTCTime , issueEventsUrl :: !URL , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: !(Vector IssueLabel) , issueNumber :: !Int , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text , issuePullRequest :: !(Maybe PullRequestReference) , issueUrl :: !URL , issueCreatedAt :: !UTCTime , issueBody :: !(Maybe Text) , issueState :: !IssueState , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: !Text , newIssueBody :: !(Maybe Text) , newIssueAssignee :: !(Maybe Text) , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) , editIssueAssignee :: !(Maybe (Name User)) , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue data IssueComment = IssueComment { issueCommentUpdatedAt :: !UTCTime , issueCommentUser :: !SimpleUser , issueCommentUrl :: !URL , issueCommentHtmlUrl :: !URL , issueCommentCreatedAt :: !UTCTime , issueCommentBody :: !Text , issueCommentId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment -- | See data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. | Subscribed -- ^ The actor subscribed to receive notifications for an issue. | Unsubscribed -- ^ The issue was unsubscribed from by the actor. | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. | Assigned -- ^ The issue was assigned to the actor. | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. | Reopened -- ^ The issue was reopened by the actor. | ActorUnassigned -- ^ The issue was unassigned to the actor | Labeled -- ^ A label was added to the issue. | Unlabeled -- ^ A label was removed from the issue. | Milestoned -- ^ The issue was added to a milestone. | Demilestoned -- ^ The issue was removed from a milestone. | Renamed -- ^ The issue title was changed. | Locked -- ^ The issue was locked by the actor. | Unlocked -- ^ The issue was unlocked by the actor. | HeadRefDeleted -- ^ The pull request’s branch was deleted. | HeadRefRestored -- ^ The pull request’s branch was restored. | ReviewRequested -- ^ The actor requested review from the subject on this pull request. | ReviewDismissed -- ^ The actor dismissed a review from the pull request. | ReviewRequestRemoved -- ^ The actor removed the review request for the subject on this pull request. | MarkedAsDuplicate -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request. | UnmarkedAsDuplicate -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate. | AddedToProject -- ^ The issue was added to a project board. | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. | RemovedFromProject -- ^ The issue was removed from a project board. | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event data IssueEvent = IssueEvent { issueEventActor :: !SimpleUser , issueEventType :: !EventType , issueEventCommitId :: !(Maybe Text) , issueEventUrl :: !URL , issueEventCreatedAt :: !UTCTime , issueEventId :: !Int , issueEventIssue :: !(Maybe Issue) , issueEventLabel :: !(Maybe IssueLabel) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueEvent where rnf = genericRnf instance Binary IssueEvent instance FromJSON IssueEvent where parseJSON = withObject "Event" $ \o -> IssueEvent <$> o .: "actor" <*> o .: "event" <*> o .:? "commit_id" <*> o .: "url" <*> o .: "created_at" <*> o .: "id" <*> o .:? "issue" <*> o .:? "label" instance FromJSON EventType where parseJSON = withText "EventType" $ \t -> case t 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 <$> o .: "updated_at" <*> o .: "user" <*> o .: "url" <*> o .: "html_url" <*> o .: "created_at" <*> o .: "body" <*> o .: "id" instance FromJSON Issue where parseJSON = withObject "Issue" $ \o -> Issue <$> o .:? "closed_at" <*> o .: "updated_at" <*> o .: "events_url" <*> o .: "html_url" <*> o .:? "closed_by" <*> o .: "labels" <*> o .: "number" <*> o .: "assignees" <*> o .: "user" <*> o .: "title" <*> o .:? "pull_request" <*> o .: "url" <*> o .: "created_at" <*> o .: "body" <*> o .: "state" <*> o .: "id" <*> o .: "comments" <*> o .:? "milestone" instance ToJSON NewIssue where toJSON (NewIssue t b a m ls) = object [ "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 github-0.20/src/GitHub/Data/Releases.hs0000644000000000000000000000533413352724157016042 0ustar0000000000000000module GitHub.Data.Releases where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Release = Release { releaseUrl :: !URL , releaseHtmlUrl :: !URL , releaseAssetsurl :: !URL , releaseUploadUrl :: !URL , releaseTarballUrl :: !URL , releaseZipballUrl :: !URL , releaseId :: !(Id Release) , releaseTagName :: !Text , releaseTargetCommitish :: !Text , releaseName :: !Text , releaseBody :: !Text , releaseDraft :: !Bool , releasePrerelease :: !Bool , releaseCreatedAt :: !UTCTime , releasePublishedAt :: !(Maybe UTCTime) , releaseAuthor :: !SimpleUser , releaseAssets :: !(Vector ReleaseAsset) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON Release where parseJSON = withObject "Event" $ \o -> Release <$> o .: "url" <*> o .: "html_url" <*> o .: "assets_url" <*> o .: "upload_url" <*> o .: "tarball_url" <*> o .: "zipball_url" <*> o .: "id" <*> o .: "tag_name" <*> o .: "target_commitish" <*> o .: "name" <*> o .: "body" <*> o .: "draft" <*> o .: "prerelease" <*> o .: "created_at" <*> o .:? "published_at" <*> o .: "author" <*> o .: "assets" instance NFData Release where rnf = genericRnf instance Binary Release data ReleaseAsset = ReleaseAsset { releaseAssetUrl :: !URL , releaseAssetBrowserDownloadUrl :: !Text , releaseAssetId :: !(Id ReleaseAsset) , releaseAssetName :: !Text , releaseAssetLabel :: !(Maybe Text) , releaseAssetState :: !Text , releaseAssetContentType :: !Text , releaseAssetSize :: !Int , releaseAssetDownloadCount :: !Int , releaseAssetCreatedAt :: !UTCTime , releaseAssetUpdatedAt :: !UTCTime , releaseAssetUploader :: !SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON ReleaseAsset where parseJSON = withObject "Event" $ \o -> ReleaseAsset <$> o .: "url" <*> o .: "browser_download_url" <*> o .: "id" <*> o .: "name" <*> o .:? "label" <*> o .: "state" <*> o .: "content_type" <*> o .: "size" <*> o .: "download_count" <*> o .: "created_at" <*> o .: "updated_at" <*> o .: "uploader" instance NFData ReleaseAsset where rnf = genericRnf instance Binary ReleaseAsset github-0.20/src/GitHub/Data/Email.hs0000644000000000000000000000225213352724156015321 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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" github-0.20/src/GitHub/Data/Teams.hs0000644000000000000000000001765713352724157015363 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Teams where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Privacy = PrivacyClosed | PrivacySecret deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Privacy where rnf = genericRnf instance Binary Privacy data Permission = PermissionPull | PermissionPush | PermissionAdmin deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Permission where rnf = genericRnf instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission { addTeamRepoPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData AddTeamRepoPermission where rnf = genericRnf instance Binary AddTeamRepoPermission data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) , simpleTeamUrl :: !URL , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. , simpleTeamSlug :: !(Name Team) , simpleTeamDescription :: !(Maybe Text) , simpleTeamPrivacy :: !(Maybe Privacy) , simpleTeamPermission :: !Permission , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) , teamUrl :: !URL , teamName :: !Text , teamSlug :: !(Name Team) , teamDescription :: !(Maybe Text) , teamPrivacy :: !(Maybe Privacy) , teamPermission :: !Permission , teamMembersUrl :: !URL , teamRepositoriesUrl :: !URL , teamMembersCount :: !Int , teamReposCount :: !Int , teamOrganization :: !SimpleOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf instance Binary Team data CreateTeam = CreateTeam { createTeamName :: !(Name Team) , createTeamDescription :: !(Maybe Text) , createTeamRepoNames :: !(Vector (Name Repo)) -- , createTeamPrivacy :: Privacy , createTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeam where rnf = genericRnf instance Binary CreateTeam data EditTeam = EditTeam { editTeamName :: !(Name Team) , editTeamDescription :: !(Maybe Text) -- , editTeamPrivacy :: Privacy , editTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam where rnf = genericRnf instance Binary EditTeam data Role = RoleMaintainer | RoleMember deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Role instance Binary Role data ReqState = StatePending | StateActive deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ReqState where rnf = genericRnf instance Binary ReqState data TeamMembership = TeamMembership { teamMembershipUrl :: !URL , teamMembershipRole :: !Role , teamMembershipReqState :: !ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData TeamMembership where rnf = genericRnf instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeamMembership where rnf = genericRnf instance Binary CreateTeamMembership -- JSON Instances instance FromJSON SimpleTeam where parseJSON = withObject "SimpleTeam" $ \o -> SimpleTeam <$> o .: "id" <*> o .: "url" <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing <*> o .:?"privacy" .!= Nothing <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" instance FromJSON Team where parseJSON = withObject "Team" $ \o -> Team <$> o .: "id" <*> o .: "url" <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing <*> o .:?"privacy" .!= Nothing <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" <*> o .: "members_count" <*> o .: "repos_count" <*> o .: "organization" instance ToJSON CreateTeam where toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = object [ "name" .= name , "description" .= desc , "repo_names" .= repo_names {-, "privacy" .= privacy-} , "permissions" .= permissions ] instance ToJSON EditTeam where toJSON (EditTeam name desc {-privacy-} permissions) = object [ "name" .= name , "description" .= desc {-, "privacy" .= privacy-} , "permissions" .= permissions ] instance FromJSON TeamMembership where parseJSON = withObject "TeamMembership" $ \o -> TeamMembership <$> o .: "url" <*> o .: "role" <*> o .: "state" instance FromJSON CreateTeamMembership where parseJSON = withObject "CreateTeamMembership" $ \o -> CreateTeamMembership <$> o .: "role" instance ToJSON CreateTeamMembership where toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = object [ "role" .= role ] instance FromJSON AddTeamRepoPermission where parseJSON = withObject "AddTeamRepoPermission" $ \o -> AddTeamRepoPermission <$> o .: "permission" instance ToJSON AddTeamRepoPermission where toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = object [ "permission" .= permission ] instance FromJSON Role where parseJSON = withText "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" 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 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 instance ToJSON ReqState where toJSON StateActive = String "active" toJSON StatePending = String "pending" -- | Filters members returned by their role in the team. data TeamMemberRole = TeamMemberRoleAll -- ^ all members of the team. | TeamMemberRoleMaintainer -- ^ team maintainers | TeamMemberRoleMember -- ^ normal members of the team. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) github-0.20/src/GitHub/Data/Search.hs0000644000000000000000000000266713352724157015512 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Search where import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V data SearchResult entity = SearchResult { searchResultTotalCount :: !Int , searchResultResults :: !(Vector entity) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf instance Binary entity => Binary (SearchResult entity) instance FromJSON entity => FromJSON (SearchResult entity) where parseJSON = withObject "SearchResult" $ \o -> SearchResult <$> o .: "total_count" <*> o .:? "items" .!= V.empty data Code = Code { codeName :: !Text , codePath :: !Text , codeSha :: !Text , codeUrl :: !URL , codeGitUrl :: !URL , codeHtmlUrl :: !URL , codeRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code where rnf = genericRnf instance Binary Code instance FromJSON Code where parseJSON = withObject "Code" $ \o -> Code <$> o .: "name" <*> o .: "path" <*> o .: "sha" <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" <*> o .: "repository" github-0.20/src/GitHub/Data/Options.hs0000644000000000000000000004622213352724157015733 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Module with modifiers for pull requests' and issues' listings. module GitHub.Data.Options ( -- * Common modifiers stateOpen, stateClosed, stateAll, sortAscending, sortDescending, sortByCreated, sortByUpdated, -- * Pull Requests PullRequestMod, prModToQueryString, optionsBase, optionsNoBase, optionsHead, optionsNoHead, sortByPopularity, sortByLongRunning, -- * Issues IssueMod, issueModToQueryString, sortByComments, optionsLabels, optionsSince, optionsSinceAll, optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, optionsSubscribedIssues, optionsAllIssues, -- * Repo issues IssueRepoMod, issueRepoModToQueryString, optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, -- * Data IssueState (..), MergeableState (..), -- * Internal HasState, HasDirection, HasCreatedUpdated, HasComments, HasLabels, HasSince, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id, untagId) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T import qualified Data.Text.Encoding as TE ------------------------------------------------------------------------------- -- Data ------------------------------------------------------------------------------- -- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state data IssueState = StateOpen | StateClosed deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance ToJSON IssueState where toJSON StateOpen = String "open" toJSON StateClosed = String "closed" instance FromJSON IssueState where parseJSON (String "open") = pure StateOpen parseJSON (String "closed") = pure StateClosed parseJSON v = typeMismatch "IssueState" v instance NFData IssueState where rnf = genericRnf instance Binary IssueState -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state data MergeableState = StateUnknown | StateClean | StateDirty | StateUnstable | StateBlocked | StateBehind deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance ToJSON MergeableState where toJSON StateUnknown = String "unknown" toJSON StateClean = String "clean" toJSON StateDirty = String "dirty" toJSON StateUnstable = String "unstable" toJSON StateBlocked = String "blocked" toJSON StateBehind = String "behind" instance FromJSON MergeableState where parseJSON (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 instance NFData MergeableState where rnf = genericRnf instance Binary MergeableState data SortDirection = SortAscending | SortDescending deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData SortDirection where rnf = genericRnf instance Binary SortDirection -- PR data SortPR = SortPRCreated | SortPRUpdated | SortPRPopularity | SortPRLongRunning deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData SortPR where rnf = genericRnf instance Binary SortPR -- Issue data IssueFilter = IssueFilterAssigned | IssueFilterCreated | IssueFilterMentioned | IssueFilterSubscribed | IssueFilterAll deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData IssueFilter where rnf = genericRnf instance Binary IssueFilter data SortIssue = SortIssueCreated | SortIssueUpdated | SortIssueComments deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData SortIssue where rnf = genericRnf instance Binary SortIssue data FilterBy a = FilterAny | FilterNone | FilterBy a | FilterNotSpecified -- ^ e.g. for milestones "any" means "any milestone". -- I.e. won't show issues without mileston specified deriving (Eq, Ord, Show, Generic, Typeable, Data) ------------------------------------------------------------------------------- -- Classes ------------------------------------------------------------------------------- class HasState mod where state :: Maybe IssueState -> mod stateOpen :: HasState mod => mod stateOpen = state (Just StateOpen) stateClosed :: HasState mod => mod stateClosed = state (Just StateClosed) stateAll :: HasState mod => mod stateAll = state Nothing instance HasState PullRequestMod where state s = PRMod $ \opts -> opts { pullRequestOptionsState = s } instance HasState IssueMod where state s = IssueMod $ \opts -> opts { issueOptionsState = s } instance HasState IssueRepoMod where state s = IssueRepoMod $ \opts -> opts { issueRepoOptionsState = s } class HasDirection mod where sortDir :: SortDirection -> mod sortAscending :: HasDirection mod => mod sortAscending = sortDir SortAscending sortDescending :: HasDirection mod => mod sortDescending = sortDir SortDescending instance HasDirection PullRequestMod where sortDir x = PRMod $ \opts -> opts { pullRequestOptionsDirection = x } instance HasDirection IssueMod where sortDir x = IssueMod $ \opts -> opts { issueOptionsDirection = x } instance HasDirection IssueRepoMod where sortDir x = IssueRepoMod $ \opts -> opts { issueRepoOptionsDirection = x } class HasCreatedUpdated mod where sortByCreated :: mod sortByUpdated :: mod instance HasCreatedUpdated PullRequestMod where sortByCreated = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRCreated } sortByUpdated = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRUpdated } instance HasCreatedUpdated IssueMod where sortByCreated = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueCreated } sortByUpdated = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueUpdated } instance HasCreatedUpdated IssueRepoMod where sortByCreated = IssueRepoMod $ \opts -> opts { issueRepoOptionsSort = SortIssueCreated } sortByUpdated = IssueRepoMod $ \opts -> opts { issueRepoOptionsSort = SortIssueUpdated } ------------------------------------------------------------------------------- -- Pull Request ------------------------------------------------------------------------------- -- | See . data PullRequestOptions = PullRequestOptions { pullRequestOptionsState :: !(Maybe IssueState) , pullRequestOptionsHead :: !(Maybe Text) , pullRequestOptionsBase :: !(Maybe Text) , pullRequestOptionsSort :: !SortPR , pullRequestOptionsDirection :: !SortDirection } deriving (Eq, Ord, Show, Generic, Typeable, Data) defaultPullRequestOptions :: PullRequestOptions defaultPullRequestOptions = PullRequestOptions { pullRequestOptionsState = Just StateOpen , pullRequestOptionsHead = Nothing , pullRequestOptionsBase = Nothing , pullRequestOptionsSort = SortPRCreated , pullRequestOptionsDirection = SortDescending } -- | See . newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions) instance Semigroup PullRequestMod where PRMod f <> PRMod g = PRMod (g . f) instance Monoid PullRequestMod where mempty = PRMod id mappend = (<>) toPullRequestOptions :: PullRequestMod -> PullRequestOptions toPullRequestOptions (PRMod f) = f defaultPullRequestOptions prModToQueryString :: PullRequestMod -> QueryString prModToQueryString = pullRequestOptionsToQueryString . toPullRequestOptions pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = [ mk "state" state' , mk "sort" sort' , mk "direction" direction' ] ++ catMaybes [ mk "head" <$> head' , mk "base" <$> base' ] where mk k v = (k, Just v) state' = case st of Nothing -> "all" Just StateOpen -> "open" Just StateClosed -> "closed" sort' = case sort of SortPRCreated -> "created" SortPRUpdated -> "updated" SortPRPopularity -> "popularity" SortPRLongRunning -> "long-running" direction' = case dir of SortDescending -> "desc" SortAscending -> "asc" head' = fmap TE.encodeUtf8 head_ base' = fmap TE.encodeUtf8 base ------------------------------------------------------------------------------- -- Pull request modifiers ------------------------------------------------------------------------------- optionsBase :: Text -> PullRequestMod optionsBase x = PRMod $ \opts -> opts { pullRequestOptionsBase = Just x } optionsNoBase :: PullRequestMod optionsNoBase = PRMod $ \opts -> opts { pullRequestOptionsBase = Nothing } optionsHead :: Text -> PullRequestMod optionsHead x = PRMod $ \opts -> opts { pullRequestOptionsHead = Just x } optionsNoHead :: PullRequestMod optionsNoHead = PRMod $ \opts -> opts { pullRequestOptionsHead = Nothing } sortByPopularity :: PullRequestMod sortByPopularity = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRPopularity } sortByLongRunning :: PullRequestMod sortByLongRunning = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRLongRunning } ------------------------------------------------------------------------------- -- Issues ------------------------------------------------------------------------------- -- | See . data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) , issueOptionsLabels :: ![Name IssueLabel] -- TODO: change to newtype , issueOptionsSort :: !SortIssue , issueOptionsDirection :: !SortDirection , issueOptionsSince :: !(Maybe UTCTime) } deriving (Eq, Ord, Show, Generic, Typeable, Data) defaultIssueOptions :: IssueOptions defaultIssueOptions = IssueOptions { issueOptionsFilter = IssueFilterAssigned , issueOptionsState = Just StateOpen , issueOptionsLabels = [] , issueOptionsSort = SortIssueCreated , issueOptionsDirection = SortDescending , issueOptionsSince = Nothing } -- | See . newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) instance Semigroup IssueMod where IssueMod f <> IssueMod g = IssueMod (g . f) instance Monoid IssueMod where mempty = IssueMod id mappend = (<>) toIssueOptions :: IssueMod -> IssueOptions toIssueOptions (IssueMod f) = f defaultIssueOptions issueModToQueryString :: IssueMod -> QueryString issueModToQueryString = issueOptionsToQueryString . toIssueOptions issueOptionsToQueryString :: IssueOptions -> QueryString issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = [ mk "state" state' , mk "sort" sort' , mk "direction" direction' , mk "filter" filt' ] ++ catMaybes [ mk "labels" <$> labels' , mk "since" <$> since' ] where mk k v = (k, Just v) filt' = case filt of IssueFilterAssigned -> "assigned" IssueFilterCreated -> "created" IssueFilterMentioned -> "mentioned" IssueFilterSubscribed -> "subscribed" IssueFilterAll -> "all" state' = case st of Nothing -> "all" Just StateOpen -> "open" Just StateClosed -> "closed" sort' = case sort of SortIssueCreated -> "created" SortIssueUpdated -> "updated" SortIssueComments -> "comments" direction' = case dir of SortDescending -> "desc" SortAscending -> "asc" since' = fmap (TE.encodeUtf8 . T.pack . show) since labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing labels nullToNothing :: Foldable f => f a -> Maybe (f a) nullToNothing xs | null xs = Nothing | otherwise = Just xs ------------------------------------------------------------------------------- -- Issues modifiers ------------------------------------------------------------------------------- class HasComments mod where sortByComments :: mod instance HasComments IssueMod where sortByComments = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueComments } instance HasComments IssueRepoMod where sortByComments = IssueRepoMod $ \opts -> opts { issueRepoOptionsSort = SortIssueComments } class HasLabels mod where optionsLabels :: Foldable f => f (Name IssueLabel) -> mod instance HasLabels IssueMod where optionsLabels lbls = IssueMod $ \opts -> opts { issueOptionsLabels = toList lbls } instance HasLabels IssueRepoMod where optionsLabels lbls = IssueRepoMod $ \opts -> opts { issueRepoOptionsLabels = toList lbls } class HasSince mod where optionsSince :: UTCTime -> mod optionsSinceAll :: mod instance HasSince IssueMod where optionsSince since = IssueMod $ \opts -> opts { issueOptionsSince = Just since } optionsSinceAll = IssueMod $ \opts -> opts { issueOptionsSince = Nothing } instance HasSince IssueRepoMod where optionsSince since = IssueRepoMod $ \opts -> opts { issueRepoOptionsSince = Just since } optionsSinceAll = IssueRepoMod $ \opts -> opts { issueRepoOptionsSince = Nothing } ------------------------------------------------------------------------------- -- Only issues modifiers ------------------------------------------------------------------------------- optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, optionsSubscribedIssues, optionsAllIssues :: IssueMod optionsAssignedIssues = issueFilter IssueFilterAssigned optionsCreatedIssues = issueFilter IssueFilterCreated optionsMentionedIssues = issueFilter IssueFilterMentioned optionsSubscribedIssues = issueFilter IssueFilterSubscribed optionsAllIssues = issueFilter IssueFilterAll issueFilter :: IssueFilter -> IssueMod issueFilter f = IssueMod $ \opts -> opts { issueOptionsFilter = f } ------------------------------------------------------------------------------- -- Issues repo ------------------------------------------------------------------------------- data IssueRepoOptions = IssueRepoOptions { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) , issueRepoOptionsState :: !(Maybe IssueState) , issueRepoOptionsAssignee :: !(FilterBy (Name User)) , issueRepoOptionsCreator :: !(Maybe (Name User)) , issueRepoOptionsMentioned :: !(Maybe (Name User)) , issueRepoOptionsLabels :: ![Name IssueLabel] , issueRepoOptionsSort :: !SortIssue , issueRepoOptionsDirection :: !SortDirection , issueRepoOptionsSince :: !(Maybe UTCTime) } deriving (Eq, Ord, Show, Generic, Typeable, Data) defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions { issueRepoOptionsMilestone = FilterNotSpecified , issueRepoOptionsState = (Just StateOpen) , issueRepoOptionsAssignee = FilterNotSpecified , issueRepoOptionsCreator = Nothing , issueRepoOptionsMentioned = Nothing , issueRepoOptionsLabels = [] , issueRepoOptionsSort = SortIssueCreated , issueRepoOptionsDirection = SortDescending , issueRepoOptionsSince = Nothing } -- | See . newtype IssueRepoMod = IssueRepoMod (IssueRepoOptions -> IssueRepoOptions) instance Semigroup IssueRepoMod where IssueRepoMod f <> IssueRepoMod g = IssueRepoMod (g . f) instance Monoid IssueRepoMod where mempty = IssueRepoMod id mappend = (<>) toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions toIssueRepoOptions (IssueRepoMod f) = f defaultIssueRepoOptions issueRepoModToQueryString :: IssueRepoMod -> QueryString issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString issueRepoOptionsToQueryString IssueRepoOptions {..} = [ mk "state" state' , mk "sort" sort' , mk "direction" direction' ] ++ catMaybes [ mk "milestone" <$> milestone' , mk "assignee" <$> assignee' , mk "labels" <$> labels' , mk "since" <$> since' , mk "creator" <$> creator' , mk "mentioned" <$> mentioned' ] where mk k v = (k, Just v) filt f x = case x of FilterAny -> Just "*" FilterNone -> Just "none" FilterBy x' -> Just $ TE.encodeUtf8 $ f x' FilterNotSpecified -> Nothing milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone assignee' = filt untagName issueRepoOptionsAssignee state' = case issueRepoOptionsState of Nothing -> "all" Just StateOpen -> "open" Just StateClosed -> "closed" sort' = case issueRepoOptionsSort of SortIssueCreated -> "created" SortIssueUpdated -> "updated" SortIssueComments -> "comments" direction' = case issueRepoOptionsDirection of SortDescending -> "desc" SortAscending -> "asc" since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing issueRepoOptionsLabels creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned ------------------------------------------------------------------------------- -- Issues repo modifiers ------------------------------------------------------------------------------- -- | Don't care about milestones. -- -- 'optionsAnyMilestone' means there should be some milestone, but it can be any. -- -- See optionsIrrelevantMilestone :: IssueRepoMod optionsIrrelevantMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNotSpecified } optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterAny } optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNone } optionsIrrelevantAssignee :: IssueRepoMod optionsIrrelevantAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNotSpecified } optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterAny } optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNone } github-0.20/src/GitHub/Data/Definitions.hs0000644000000000000000000002031013352724156016540 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Definitions where import GitHub.Internal.Prelude import Prelude () import Control.Monad (mfilter) import Data.Aeson.Types (Parser) import Network.HTTP.Client (HttpException) import qualified Control.Exception as E import qualified Data.ByteString as BS import qualified Data.Text as T import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL (..)) -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. data Error = HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included. | ParseError !Text -- ^ An error in the parser itself. | JsonError !Text -- ^ The JSON is malformed or unexpected. | UserError !Text -- ^ Incorrect input. deriving (Show, Typeable) instance E.Exception Error -- | Type of the repository owners. data OwnerType = OwnerUser | OwnerOrganization deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) instance NFData OwnerType instance Binary OwnerType data SimpleUser = SimpleUser { simpleUserId :: !(Id User) , simpleUserLogin :: !(Name User) , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleUser where rnf = genericRnf instance Binary SimpleUser data SimpleOrganization = SimpleOrganization { simpleOrganizationId :: !(Id Organization) , simpleOrganizationLogin :: !(Name Organization) , simpleOrganizationUrl :: !URL , simpleOrganizationAvatarUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOrganization where rnf = genericRnf instance Binary SimpleOrganization -- | Sometimes we don't know the type of the owner, e.g. in 'Repo' data SimpleOwner = SimpleOwner { simpleOwnerId :: !(Id Owner) , simpleOwnerLogin :: !(Name Owner) , simpleOwnerUrl :: !URL , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOwner where rnf = genericRnf instance Binary SimpleOwner data User = User { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) , userType :: !OwnerType -- ^ Should always be 'OwnerUser' , userCreatedAt :: !UTCTime , userPublicGists :: !Int , userAvatarUrl :: !URL , userFollowers :: !Int , userFollowing :: !Int , userHireable :: !(Maybe Bool) , userBlog :: !(Maybe Text) , userBio :: !(Maybe Text) , userPublicRepos :: !Int , userLocation :: !(Maybe Text) , userCompany :: !(Maybe Text) , userEmail :: !(Maybe Text) , userUrl :: !URL , userHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData User where rnf = genericRnf instance Binary User data Organization = Organization { organizationId :: !(Id Organization) , organizationLogin :: !(Name Organization) , organizationName :: !(Maybe Text) , organizationType :: !OwnerType -- ^ Should always be 'OwnerOrganization' , organizationBlog :: !(Maybe Text) , organizationLocation :: !(Maybe Text) , organizationFollowers :: !Int , organizationCompany :: !(Maybe Text) , organizationAvatarUrl :: !URL , organizationPublicGists :: !Int , organizationHtmlUrl :: !URL , organizationEmail :: !(Maybe Text) , organizationFollowing :: !Int , organizationPublicRepos :: !Int , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization where rnf = genericRnf instance Binary Organization -- | In practic, you cam't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Owner where rnf = genericRnf instance Binary Owner fromOwner :: Owner -> Either User Organization fromOwner (Owner owner) = owner -- JSON instances instance FromJSON OwnerType where parseJSON = withText "Owner type" $ \t -> case t of "User" -> pure $ OwnerUser "Organization" -> pure $ OwnerOrganization _ -> fail $ "Unknown owner type: " ++ T.unpack t instance FromJSON SimpleUser where parseJSON = withObject "SimpleUser" $ \obj -> do SimpleUser <$> obj .: "id" <*> obj .: "login" <*> obj .: "avatar_url" <*> obj .: "url" instance FromJSON SimpleOrganization where parseJSON = withObject "SimpleOrganization" $ \obj -> SimpleOrganization <$> obj .: "id" <*> obj .: "login" <*> obj .: "url" <*> obj .: "avatar_url" instance FromJSON SimpleOwner where parseJSON = withObject "SimpleOwner" $ \obj -> do SimpleOwner <$> obj .: "id" <*> obj .: "login" <*> obj .: "url" <*> obj .: "avatar_url" <*> obj .: "type" parseUser :: Object -> Parser User parseUser obj = User <$> obj .: "id" <*> obj .: "login" <*> obj .:? "name" <*> obj .: "type" <*> obj .: "created_at" <*> obj .: "public_gists" <*> obj .: "avatar_url" <*> obj .: "followers" <*> obj .: "following" <*> obj .:? "hireable" <*> obj .:? "blog" <*> obj .:? "bio" <*> obj .: "public_repos" <*> obj .:? "location" <*> obj .:? "company" <*> obj .:? "email" <*> obj .: "url" <*> obj .: "html_url" parseOrganization :: Object -> Parser Organization parseOrganization obj = Organization <$> obj .: "id" <*> obj .: "login" <*> obj .:? "name" <*> obj .: "type" <*> obj .:? "blog" <*> obj .:? "location" <*> obj .: "followers" <*> obj .:? "company" <*> obj .: "avatar_url" <*> obj .: "public_gists" <*> obj .: "html_url" <*> obj .:? "email" <*> obj .: "following" <*> obj .: "public_repos" <*> obj .: "url" <*> obj .: "created_at" instance FromJSON User where parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization instance FromJSON Owner where parseJSON = withObject "Owner" $ \obj -> do t <- obj .: "type" case t of OwnerUser -> Owner . Left <$> parseUser obj OwnerOrganization -> Owner . Right <$> parseOrganization obj -- | Filter members returned in the list. data OrgMemberFilter = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners. | OrgMemberFilterAll -- ^ All members the authenticated user can see. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | Filter members returned by their role. data OrgMemberRole = OrgMemberRoleAll -- ^ All members of the organization, regardless of role. | OrgMemberRoleAdmin -- ^ Organization owners. | OrgMemberRoleMember -- ^ Non-owner organization members. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | Request query string type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int ------------------------------------------------------------------------------- -- IssueLabel ------------------------------------------------------------------------------- data IssueLabel = IssueLabel { labelColor :: !Text , labelUrl :: !URL , labelName :: !(Name IssueLabel) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueLabel where rnf = genericRnf instance Binary IssueLabel instance FromJSON IssueLabel where parseJSON = withObject "IssueLabel" $ \o -> IssueLabel <$> o .: "color" <*> o .:? "url" .!= URL "" -- in events there aren't URL <*> o .: "name" github-0.20/src/GitHub/Data/DeployKeys.hs0000644000000000000000000000306413352724156016364 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Todd Mohney -- module GitHub.Data.DeployKeys where import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data RepoDeployKey = RepoDeployKey { repoDeployKeyId :: !(Id RepoDeployKey) , repoDeployKeyKey :: !Text , repoDeployKeyUrl :: !URL , repoDeployKeyTitle :: !Text , repoDeployKeyVerified :: !Bool , repoDeployKeyCreatedAt :: !UTCTime , repoDeployKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON RepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey <$> o .: "id" <*> o .: "key" <*> o .: "url" <*> o .: "title" <*> o .: "verified" <*> o .: "created_at" <*> o .: "read_only" data NewRepoDeployKey = NewRepoDeployKey { newRepoDeployKeyKey :: !Text , newRepoDeployKeyTitle :: !Text , newRepoDeployKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where toJSON (NewRepoDeployKey key title readOnly) = object [ "key" .= key , "title" .= title , "read_only" .= readOnly ] instance FromJSON NewRepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> NewRepoDeployKey <$> o .: "key" <*> o .: "title" <*> o .: "read_only" github-0.20/src/GitHub/Data/Activities.hs0000644000000000000000000000130613352724156016375 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Activities where 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) instance NFData RepoStarred where rnf = genericRnf instance Binary RepoStarred -- JSON Instances instance FromJSON RepoStarred where parseJSON = withObject "RepoStarred" $ \o -> RepoStarred <$> o .: "starred_at" <*> o .: "repo" github-0.20/src/GitHub/Data/Deployments.hs0000644000000000000000000002011613352724156016574 0ustar0000000000000000{-# 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 ] github-0.20/src/GitHub/Data/Repos.hs0000644000000000000000000002243313352724157015366 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ -- orphan-ish instance for @aeson < 1@ module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Request (IsPathPart (..)) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.HashMap.Strict as HM #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) #else #ifdef UNSAFE import Unsafe.Coerce (unsafeCoerce) #endif #endif data Repo = Repo { repoSshUrl :: !(Maybe URL) , repoDescription :: !(Maybe Text) , repoCreatedAt :: !(Maybe UTCTime) , repoHtmlUrl :: !URL , repoSvnUrl :: !(Maybe URL) , repoForks :: !(Maybe Int) , repoHomepage :: !(Maybe Text) , repoFork :: !(Maybe Bool) , repoGitUrl :: !(Maybe URL) , repoPrivate :: !Bool , repoArchived :: !Bool , repoCloneUrl :: !(Maybe URL) , repoSize :: !(Maybe Int) , repoUpdatedAt :: !(Maybe UTCTime) , repoWatchers :: !(Maybe Int) , repoOwner :: !SimpleOwner , repoName :: !(Name Repo) , repoLanguage :: !(Maybe Language) , repoDefaultBranch :: !(Maybe Text) , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories , repoId :: !(Id Repo) , repoUrl :: !URL , repoOpenIssues :: !(Maybe Int) , repoHasWiki :: !(Maybe Bool) , repoHasIssues :: !(Maybe Bool) , repoHasDownloads :: !(Maybe Bool) , repoParent :: !(Maybe RepoRef) , repoSource :: !(Maybe RepoRef) , repoHooksUrl :: !URL , repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance Binary Repo data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef data NewRepo = NewRepo { newRepoName :: !(Name Repo) , newRepoDescription :: !(Maybe Text) , newRepoHomepage :: !(Maybe Text) , newRepoPrivate :: !(Maybe Bool) , newRepoHasIssues :: !(Maybe Bool) , newRepoHasWiki :: !(Maybe Bool) , newRepoAutoInit :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf instance Binary NewRepo newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing data EditRepo = EditRepo { editName :: !(Maybe (Name Repo)) , editDescription :: !(Maybe Text) , editHomepage :: !(Maybe Text) , editPublic :: !(Maybe Bool) , editHasIssues :: !(Maybe Bool) , editHasWiki :: !(Maybe Bool) , editHasDownloads :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData EditRepo where rnf = genericRnf instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. data RepoPublicity = RepoPublicityAll -- ^ All repos accessible to the user. | RepoPublicityOwner -- ^ Only repos owned by the user. | RepoPublicityPublic -- ^ Only public repos. | RepoPublicityPrivate -- ^ Only private repos. | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | The value is the number of bytes of code written in that language. type Languages = HM.HashMap Language Int -- | A programming language. newtype Language = Language Text deriving (Show, Data, Typeable, Eq, Ord, Generic) getLanguage :: Language -> Text getLanguage (Language l) = l instance NFData Language where rnf = genericRnf instance Binary Language instance Hashable Language where hashWithSalt salt (Language l) = hashWithSalt salt l instance IsString Language where fromString = Language . fromString data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor where rnf = genericRnf instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url -- JSON instances instance FromJSON Repo where parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" <*> o .: "description" <*> o .:? "created_at" <*> o .: "html_url" <*> o .:? "svn_url" <*> o .:? "forks" <*> o .:? "homepage" <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" <*> o .:? "archived" .!= False <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" <*> o .:? "watchers" <*> o .: "owner" <*> o .: "name" <*> o .:? "language" <*> o .:? "default_branch" <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" <*> o .:? "open_issues" <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" <*> o .:? "parent" <*> o .:? "source" <*> o .: "hooks_url" <*> o .: "stargazers_count" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name , newRepoDescription = description , newRepoHomepage = homepage , newRepoPrivate = private , newRepoHasIssues = hasIssues , newRepoHasWiki = hasWiki , newRepoAutoInit = autoInit }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "private" .= private , "has_issues" .= hasIssues , "has_wiki" .= hasWiki , "auto_init" .= autoInit ] instance ToJSON EditRepo where toJSON (EditRepo { editName = name , editDescription = description , editHomepage = homepage , editPublic = public , editHasIssues = hasIssues , editHasWiki = hasWiki , editHasDownloads = hasDownloads }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "public" .= public , "has_issues" .= hasIssues , "has_wiki" .= hasWiki , "has_downloads" .= hasDownloads ] instance FromJSON RepoRef where parseJSON = withObject "RepoRef" $ \o -> RepoRef <$> o .: "owner" <*> o .: "name" instance FromJSON Contributor where parseJSON = withObject "Contributor" $ \o -> do t <- o .: "type" case (t :: Text) of "Anonymous" -> AnonymousContributor <$> o .: "contributions" <*> o .: "name" _ -> KnownContributor <$> o .: "contributions" <*> o .: "avatar_url" <*> o .: "login" <*> o .: "url" <*> o .: "id" <*> o .: "gravatar_id" instance FromJSON Language where parseJSON = withText "Language" (pure . Language) instance ToJSON Language where toJSON = toJSON . getLanguage #if MIN_VERSION_aeson(1,0,0) instance FromJSONKey Language where fromJSONKey = fromJSONKeyCoerce #else instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a #ifdef UNSAFE mapKeyLanguage = unsafeCoerce #else mapKeyLanguage = mapKey Language mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a mapKey f = HM.fromList . map (first f) . HM.toList #endif #endif data ArchiveFormat = ArchiveFormatTarball -- ^ ".tar.gz" format | ArchiveFormatZipball -- ^ ".zip" format deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) instance IsPathPart ArchiveFormat where toPathPart af = case af of ArchiveFormatTarball -> "tarball" ArchiveFormatZipball -> "zipball" github-0.20/src/GitHub/Data/GitData.hs0000644000000000000000000002054113352724156015610 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.GitData where import GitHub.Data.Definitions import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V -- | The options for querying commits. data CommitQueryOption = CommitQuerySha !Text | CommitQueryPath !Text | CommitQueryAuthor !Text | CommitQuerySince !UTCTime | CommitQueryUntil !UTCTime deriving (Show, Eq, Ord, Generic, Typeable, Data) data Stats = Stats { statsAdditions :: !Int , statsTotal :: !Int , statsDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats where rnf = genericRnf instance Binary Stats data Commit = Commit { commitSha :: !(Name Commit) , commitParents :: !(Vector Tree) , commitUrl :: !URL , commitGitCommit :: !GitCommit , commitCommitter :: !(Maybe SimpleUser) , commitAuthor :: !(Maybe SimpleUser) , commitFiles :: !(Vector File) , commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit where rnf = genericRnf instance Binary Commit data Tree = Tree { treeSha :: !(Name Tree) , treeUrl :: !URL , treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree where rnf = genericRnf instance Binary Tree data GitTree = GitTree { gitTreeType :: !Text , gitTreeSha :: !(Name GitTree) -- Can be empty for submodule , gitTreeUrl :: !(Maybe URL) , gitTreeSize :: !(Maybe Int) , gitTreePath :: !Text , gitTreeMode :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitTree where rnf = genericRnf instance Binary GitTree data GitCommit = GitCommit { gitCommitMessage :: !Text , gitCommitUrl :: !URL , gitCommitCommitter :: !GitUser , gitCommitAuthor :: !GitUser , gitCommitTree :: !Tree , gitCommitSha :: !(Maybe (Name GitCommit)) , gitCommitParents :: !(Vector Tree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit data Blob = Blob { blobUrl :: !URL , blobEncoding :: !Text , blobContent :: !Text , blobSha :: !(Name Blob) , blobSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob where rnf = genericRnf instance Binary Blob data Tag = Tag { tagName :: !Text , tagZipballUrl :: !URL , tagTarballUrl :: !URL , tagCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag where rnf = genericRnf instance Binary Tag data Branch = Branch { branchName :: !Text , branchCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Branch where rnf = genericRnf data BranchCommit = BranchCommit { branchCommitSha :: !Text , branchCommitUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf instance Binary BranchCommit data Diff = Diff { diffStatus :: !Text , diffBehindBy :: !Int , diffPatchUrl :: !URL , diffUrl :: !URL , diffBaseCommit :: !Commit , diffCommits :: !(Vector Commit) , diffTotalCommits :: !Int , diffHtmlUrl :: !URL , diffFiles :: !(Vector File) , diffAheadBy :: !Int , diffDiffUrl :: !URL , diffPermalinkUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf instance Binary Diff data NewGitReference = NewGitReference { newGitReferenceRef :: !Text , newGitReferenceSha :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewGitReference where rnf = genericRnf instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject , gitReferenceUrl :: !URL , gitReferenceRef :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference where rnf = genericRnf instance Binary GitReference data GitObject = GitObject { gitObjectType :: !Text , gitObjectSha :: !Text , gitObjectUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf instance Binary GitObject data GitUser = GitUser { gitUserName :: !Text , gitUserEmail :: !Text , gitUserDate :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser where rnf = genericRnf instance Binary GitUser data File = File { fileBlobUrl :: !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 -- JSON instances instance FromJSON Stats where parseJSON = withObject "Stats" $ \o -> Stats <$> o .: "additions" <*> o .: "total" <*> o .: "deletions" instance FromJSON Commit where parseJSON = withObject "Commit" $ \o -> Commit <$> o .: "sha" <*> o .: "parents" <*> o .: "url" <*> o .: "commit" <*> o .:? "committer" <*> o .:? "author" <*> o .:? "files" .!= V.empty <*> o .:? "stats" instance FromJSON Tree where parseJSON = withObject "Tree" $ \o -> Tree <$> o .: "sha" <*> o .: "url" <*> o .:? "tree" .!= V.empty instance FromJSON GitTree where parseJSON = withObject "GitTree" $ \o -> GitTree <$> o .: "type" <*> o .: "sha" <*> o .:? "url" <*> o .:? "size" <*> o .: "path" <*> o .: "mode" instance FromJSON GitCommit where parseJSON = withObject "GitCommit" $ \o -> GitCommit <$> o .: "message" <*> o .: "url" <*> o .: "committer" <*> o .: "author" <*> o .: "tree" <*> o .:? "sha" <*> o .:? "parents" .!= V.empty instance FromJSON GitUser where parseJSON = withObject "GitUser" $ \o -> GitUser <$> o .: "name" <*> o .: "email" <*> o .: "date" instance FromJSON File where parseJSON = withObject "File" $ \o -> File <$> o .: "blob_url" <*> o .: "status" <*> o .: "raw_url" <*> o .: "additions" <*> o .: "sha" <*> o .: "changes" <*> o .:? "patch" <*> o .: "filename" <*> o .: "deletions" instance ToJSON NewGitReference where toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] instance FromJSON GitReference where parseJSON = withObject "GitReference" $ \o -> GitReference <$> o .: "object" <*> o .: "url" <*> o .: "ref" instance FromJSON GitObject where parseJSON = withObject "GitObject" $ \o -> GitObject <$> o .: "type" <*> o .: "sha" <*> o .: "url" instance FromJSON Diff where parseJSON = withObject "Diff" $ \o -> Diff <$> o .: "status" <*> o .: "behind_by" <*> o .: "patch_url" <*> o .: "url" <*> o .: "base_commit" <*> o .:? "commits" .!= V.empty <*> o .: "total_commits" <*> o .: "html_url" <*> o .:? "files" .!= V.empty <*> o .: "ahead_by" <*> o .: "diff_url" <*> o .: "permalink_url" instance FromJSON Blob where parseJSON = withObject "Blob" $ \o -> Blob <$> o .: "url" <*> o .: "encoding" <*> o .: "content" <*> o .: "sha" <*> o .: "size" instance FromJSON Tag where parseJSON = withObject "Tag" $ \o -> Tag <$> o .: "name" <*> o .: "zipball_url" <*> o .: "tarball_url" <*> o .: "commit" instance FromJSON Branch where parseJSON = withObject "Branch" $ \o -> Branch <$> o .: "name" <*> o .: "commit" instance FromJSON BranchCommit where parseJSON = withObject "BranchCommit" $ \o -> BranchCommit <$> o .: "sha" <*> o .: "url" github-0.20/src/GitHub/Data/Invitation.hs0000644000000000000000000000356613352724157016430 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Invitation where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.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 github-0.20/src/GitHub/Data/PullRequests.hs0000644000000000000000000002652513352724157016754 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.PullRequests ( SimplePullRequest(..), PullRequest(..), EditPullRequest(..), CreatePullRequest(..), PullRequestLinks(..), PullRequestCommit(..), PullRequestEvent(..), 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 () 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) , simplePullRequestRequestedReviewers :: (Vector SimpleUser) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL , simplePullRequestLinks :: !PullRequestLinks , simplePullRequestMergedAt :: !(Maybe UTCTime) , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest data PullRequest = PullRequest { pullRequestClosedAt :: !(Maybe UTCTime) , pullRequestCreatedAt :: !UTCTime , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL , pullRequestState :: !IssueState , pullRequestNumber :: !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) instance NFData PullRequest where rnf = genericRnf instance Binary PullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) , editPullRequestState :: !(Maybe IssueState) , editPullRequestBase :: !(Maybe Text) , editPullRequestMaintainerCanModify :: !(Maybe Bool) } deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf instance Binary EditPullRequest data CreatePullRequest = CreatePullRequest { createPullRequestTitle :: !Text , createPullRequestBody :: !Text , createPullRequestHead :: !Text , createPullRequestBase :: !Text } | CreatePullRequestIssue { createPullRequestIssueNum :: !Int , createPullRequestHead :: !Text , createPullRequestBase :: !Text } deriving (Show, Generic) instance NFData CreatePullRequest where rnf = genericRnf instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: !URL , pullRequestLinksComments :: !URL , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks where rnf = genericRnf instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: !Text , pullRequestCommitRef :: !Text , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !(Maybe Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit where rnf = genericRnf instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent { pullRequestEventAction :: !PullRequestEventType , pullRequestEventNumber :: !Int , pullRequestEventPullRequest :: !PullRequest , pullRequestRepository :: !Repo , pullRequestSender :: !SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent where rnf = genericRnf instance Binary PullRequestEvent data PullRequestEventType = PullRequestOpened | PullRequestClosed | PullRequestSynchronized | PullRequestReopened | PullRequestAssigned | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled | PullRequestReviewRequested | PullRequestReviewRequestRemoved | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf instance Binary PullRequestEventType data PullRequestReference = PullRequestReference { pullRequestReferenceHtmlUrl :: !(Maybe URL) , pullRequestReferencePatchUrl :: !(Maybe URL) , pullRequestReferenceDiffUrl :: !(Maybe URL) } deriving (Eq, Ord, Show, Generic, Typeable, Data) instance NFData PullRequestReference where rnf = genericRnf instance Binary PullRequestReference ------------------------------------------------------------------------------- -- JSON instances ------------------------------------------------------------------------------- instance FromJSON SimplePullRequest where parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" <*> o .: "patch_url" <*> o .: "state" <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" <*> o .: "_links" <*> o .:? "merged_at" <*> o .: "title" <*> o .: "id" instance ToJSON EditPullRequest where toJSON (EditPullRequest t b s base mcm) = object $ filter notNull [ "title" .= t , "body" .= b , "state" .= s , "base" .= base , "maintainer_can_modify" .= mcm ] where notNull (_, Null) = False notNull (_, _) = True instance ToJSON CreatePullRequest where toJSON (CreatePullRequest t b headPR basePR) = object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] toJSON (CreatePullRequestIssue issueNum headPR basePR) = object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] instance FromJSON PullRequest where parseJSON = withObject "PullRequest" $ \o -> PullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" <*> o .: "patch_url" <*> o .: "state" <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" <*> o .: "_links" <*> o .:? "merged_at" <*> o .: "title" <*> o .: "id" <*> o .:? "merged_by" <*> o .: "changed_files" <*> o .: "head" <*> o .: "comments" <*> o .: "deletions" <*> o .: "additions" <*> o .: "review_comments" <*> o .: "base" <*> o .: "commits" <*> o .: "merged" <*> o .:? "mergeable" <*> o .: "mergeable_state" instance FromJSON PullRequestLinks where parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks <$> fmap getHref (o .: "review_comments") <*> fmap getHref (o .: "comments") <*> fmap getHref (o .: "html") <*> fmap getHref (o .: "self") instance FromJSON PullRequestCommit where parseJSON = withObject "PullRequestCommit" $ \o -> PullRequestCommit <$> o .: "label" <*> o .: "ref" <*> o .: "sha" <*> o .: "user" <*> o .: "repo" instance FromJSON PullRequestEvent where parseJSON = withObject "PullRequestEvent" $ \o -> PullRequestEvent <$> o .: "action" <*> o .: "number" <*> o .: "pull_request" <*> o .: "repository" <*> o .: "sender" instance FromJSON PullRequestEventType where parseJSON (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 instance FromJSON PullRequestReference where parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference <$> o .:? "html_url" <*> o .:? "patch_url" <*> o .:? "diff_url" -- Helpers newtype Href a = Href { getHref :: a } instance FromJSON a => FromJSON (Href a) where parseJSON = withObject "href object" $ \obj -> Href <$> obj .: "href" -- | Pull request merge results data MergeResult = MergeSuccessful | MergeCannotPerform | MergeConflict deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) statusMerge :: StatusMap MergeResult statusMerge = [ (200, MergeSuccessful) , (405, MergeCannotPerform) , (409, MergeConflict) ] github-0.20/src/GitHub/Data/Webhooks/0000755000000000000000000000000013352724157015517 5ustar0000000000000000github-0.20/src/GitHub/Data/Webhooks/Validate.hs0000644000000000000000000000252113352724157017604 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Verification of incomming webhook payloads, as described at -- module GitHub.Data.Webhooks.Validate ( isValidPayload ) where import GitHub.Internal.Prelude import Prelude () import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) import Data.Byteable (constEqBytes, toBytes) import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE -- | Validates a given payload against a given HMAC hexdigest using a given -- secret. -- Returns 'True' iff the given hash is non-empty and it's a valid signature of -- the payload. isValidPayload :: Text -- ^ the secret -> Maybe Text -- ^ the hash provided by the remote party -- in @X-Hub-Signature@ (if any), -- including the 'sha1=...' prefix -> ByteString -- ^ the body -> Bool isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS where shaOptBS = TE.encodeUtf8 <$> shaOpt hexDigest = Hex.encode . toBytes . hmacGetDigest hm = hmac (TE.encodeUtf8 secret) payload :: HMAC SHA1 sign = "sha1=" <> hexDigest hm github-0.20/src/GitHub/Endpoints/0000755000000000000000000000000013352724157015030 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Gists.hs0000644000000000000000000000602413352724157016457 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The gists API as described at . module GitHub.Endpoints.Gists ( gists, gists', gistsR, gist, gist', gistR, starGist, starGistR, unstarGist, unstarGistR, deleteGist, deleteGistR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The list of all gists created by the user -- -- > gists' (Just ("github-username", "github-password")) "mike-burns" gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = executeRequestMaybe auth $ gistsR user FetchAll -- | The list of all public gists created by the user. -- -- > gists "mike-burns" gists :: Name Owner -> IO (Either Error (Vector Gist)) gists = gists' Nothing -- | List gists. -- See gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- -- > gist' (Just ("github-username", "github-password")) "225074" gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) gist' auth gid = executeRequestMaybe auth $ gistR gid -- | A specific gist, given its id. -- -- > gist "225074" gist :: Name Gist -> IO (Either Error Gist) gist = gist' Nothing -- | Query a single gist. -- See gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] -- | Star a gist by the authenticated user. -- -- > starGist ("github-username", "github-password") "225074" starGist :: Auth -> Name Gist -> IO (Either Error ()) starGist auth gid = executeRequest auth $ starGistR gid -- | 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" 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 github-0.20/src/GitHub/Endpoints/RateLimit.hs0000644000000000000000000000215213352724157017256 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github RateLimit API, as described at -- . module GitHub.Endpoints.RateLimit ( rateLimitR, rateLimit, rateLimit', module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- With authentication. rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) rateLimit' auth = executeRequestMaybe auth rateLimitR -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- Without authentication. rateLimit :: IO (Either Error RateLimit) rateLimit = rateLimit' Nothing -- | Get your current rate limit status. -- rateLimitR :: Request k RateLimit rateLimitR = query ["rate_limit"] [] github-0.20/src/GitHub/Endpoints/Users.hs0000644000000000000000000000346213352724157016472 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Users API, as described at -- . module GitHub.Endpoints.Users ( userInfoFor, userInfoFor', userInfoForR, ownerInfoForR, userInfoCurrent', userInfoCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The information for a single user, by login name. -- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" userInfoFor :: Name User -> IO (Either Error User) userInfoFor = executeRequest' . userInfoForR -- | Query a single user. -- See userInfoForR :: Name User -> Request k User userInfoForR user = query ["users", toPathPart user] [] -- | Query a single user or an organization. -- See ownerInfoForR :: Name Owner -> Request k Owner ownerInfoForR owner = query ["users", toPathPart owner] [] -- | Retrieve information about the user associated with the supplied authentication. -- -- > userInfoCurrent' (OAuth "...") userInfoCurrent' :: Auth -> IO (Either Error User) userInfoCurrent' auth = executeRequest auth $ userInfoCurrentR -- | Query the authenticated user. -- See userInfoCurrentR :: Request 'RA User userInfoCurrentR = query ["user"] [] github-0.20/src/GitHub/Endpoints/Issues.hs0000644000000000000000000001122713352724157016642 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The issues API as described on . module GitHub.Endpoints.Issues ( currentUserIssuesR, organizationIssuesR, issue, issue', issueR, issuesForRepo, issuesForRepo', issuesForRepoR, createIssue, createIssueR, newIssue, editIssue, editIssueR, editOfIssue, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | See . currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) currentUserIssuesR opts = pagedQuery ["user", "issues"] (issueModToQueryString opts) -- | See . organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) organizationIssuesR org opts = pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' -- -- > issue' (Just ("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 ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName opts = executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) issuesForRepoR user reqRepoName opts = pagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = issueRepoModToQueryString opts -- Creating new issues. newIssue :: Text -> NewIssue newIssue title = NewIssue title Nothing Nothing Nothing Nothing -- | Create a new issue. -- -- > createIssue (User (user, password)) user repo -- > (newIssue "some_repo") {...} createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue -> IO (Either Error Issue) createIssue auth user repo ni = executeRequest auth $ createIssueR user repo ni -- | Create an issue. -- See createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue createIssueR user repo = command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- -- > editIssue (User (user, password)) user repo issue -- > editOfIssue {...} editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue -> IO (Either Error Issue) editIssue auth user repo iss edit = executeRequest auth $ editIssueR user repo iss edit -- | Edit an issue. -- See editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue editIssueR user repo iss = command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode github-0.20/src/GitHub/Endpoints/Organizations.hs0000644000000000000000000000444013352724157020215 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The orgs API as described on . module GitHub.Endpoints.Organizations ( publicOrganizationsFor, publicOrganizationsFor', publicOrganizationsForR, publicOrganization, publicOrganization', publicOrganizationR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org FetchAll -- | List user organizations. The public organizations for a user, given the user's login. -- -- > publicOrganizationsFor "mike-burns" publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR -- | Query an organization. Details on a public organization. Takes the organization's login. -- -- > publicOrganization "thoughtbot" publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing -- | Query an organization. -- See publicOrganizationR :: Name Organization -> Request k Organization publicOrganizationR reqOrganizationName = query ["orgs", toPathPart reqOrganizationName] [] github-0.20/src/GitHub/Endpoints/Search.hs0000644000000000000000000000571413352724157016600 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Search API, as described at -- . module GitHub.Endpoints.Search( searchRepos', searchRepos, searchReposR, searchCode', searchCode, searchCodeR, searchIssues', searchIssues, searchIssuesR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () import qualified Data.Text.Encoding as TE -- | Perform a repository search. -- With authentication. -- -- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. -- Without authentication. -- -- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos :: Text -> IO (Either Error (SearchResult Repo)) searchRepos = searchRepos' Nothing -- | Search repositories. -- See searchReposR :: Text -> Request k (SearchResult Repo) searchReposR searchString = query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. -- -- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. -- Without authentication. -- -- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" searchCode :: Text -> IO (Either Error (SearchResult Code)) searchCode = searchCode' Nothing -- | Search code. -- See searchCodeR :: Text -> Request k (SearchResult Code) searchCodeR searchString = query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. -- -- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. -- Without authentication. -- -- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" searchIssues :: Text -> IO (Either Error (SearchResult Issue)) searchIssues = searchIssues' Nothing -- | Search issues. -- See searchIssuesR :: Text -> Request k (SearchResult Issue) searchIssuesR searchString = query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] github-0.20/src/GitHub/Endpoints/Repos.hs0000644000000000000000000002733113352724157016462 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Repos API, as documented at -- module GitHub.Endpoints.Repos ( -- * Querying repositories currentUserRepos, currentUserReposR, userRepos, userRepos', userReposR, organizationRepos, organizationRepos', organizationReposR, repository, repository', repositoryR, contributors, contributors', contributorsR, contributorsWithAnonymous, contributorsWithAnonymous', languagesFor, languagesFor', languagesForR, tagsFor, tagsFor', tagsForR, branchesFor, branchesFor', branchesForR, -- ** Create createRepo', createRepoR, createOrganizationRepo', createOrganizationRepoR, forkExistingRepoR, -- ** Edit editRepo, editRepoR, -- ** Delete deleteRepo, deleteRepoR, -- * Data module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) currentUserRepos auth publicity = executeRequest auth $ currentUserReposR publicity FetchAll -- | List your repositories. -- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = pagedQuery ["user", "repos"] qs where qs = repoPublicityQueryString publicity -- | The repos for a user, by their login. Can be restricted to just repos they -- own, are a member of, or publicize. Private repos will return empty list. -- -- > userRepos "mike-burns" All userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- -- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = executeRequestMaybe auth $ userReposR user publicity FetchAll -- | List user repositories. -- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = pagedQuery ["users", toPathPart user, "repos"] qs where qs = repoPublicityQueryString publicity -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- | The repos for an organization, by the organization name. -- With authentication. -- -- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = executeRequestMaybe auth $ organizationReposR org publicity FetchAll -- | List organization repositories. -- See organizationReposR :: Name Organization -> RepoPublicity -> FetchCount -> Request k (Vector Repo) organizationReposR org publicity = pagedQuery ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity -- | Details on a specific repo, given the owner and repo name. -- -- > repository "mike-burns" "github" repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- -- > repository' (Just (BasicAuth (user, password))) "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo -- | Query single repository. -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- -- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) createRepo' auth nrepo = executeRequest auth $ createRepoR nrepo -- | Create a new repository. -- See createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) -- | Fork an existing repository. -- See -- TODO: The third paramater (an optional Organisation) is not used yet. forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'RW Repo forkExistingRepoR owner repo _morg = command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty -- | Create a new repository for an organization. -- -- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) createOrganizationRepo' auth org nrepo = executeRequest auth $ createOrganizationRepoR org nrepo -- | Create a new repository for an organization. -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = command Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- -- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} editRepo :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> EditRepo -> IO (Either Error Repo) editRepo auth user repo body = executeRequest auth $ editRepoR user repo body -- | Edit an existing repository. -- See editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo editRepoR user repo body = command Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- -- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = executeRequestMaybe auth $ contributorsR user repo False FetchAll -- | List contributors. -- See contributorsR :: Name Owner -> Name Repo -> Bool -- ^ Include anonymous -> FetchCount -> Request k (Vector Contributor) contributorsR user repo anon = pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner -- and repo name. -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner -- and repo name. -- With authentication. -- -- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = executeRequestMaybe auth $ contributorsR user repo True FetchAll -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- -- > languagesFor "mike-burns" "ohlaunch" languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor = languagesFor' Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- With authentication. -- -- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch" languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor' auth user repo = executeRequestMaybe auth $ languagesForR user repo -- | List languages. -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- -- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = executeRequestMaybe auth $ tagsForR user repo FetchAll -- | List tags. -- See tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- -- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = executeRequestMaybe auth $ branchesForR user repo FetchAll -- | List branches. -- See branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] -- | Delete an existing repository. -- -- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () deleteRepoR user repo = command Delete ["repos", toPathPart user, toPathPart repo] mempty github-0.20/src/GitHub/Endpoints/PullRequests.hs0000644000000000000000000001771113352724157020043 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The pull requests API as documented at -- . module GitHub.Endpoints.PullRequests ( pullRequestsFor, pullRequestsFor', pullRequestsForR, pullRequest', pullRequest, pullRequestR, 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 () -- | All open pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor user repo = executeRequest' $ pullRequestsForR user repo mempty FetchAll -- | All open pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor' auth user repo = executeRequestMaybe auth $ pullRequestsForR user repo mempty FetchAll -- | List pull requests. -- See pullRequestsForR :: Name Owner -> Name Repo -> PullRequestMod -> FetchCount -> Request k (Vector SimplePullRequest) pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) -- | A detailed pull request, which has much more information. This takes the -- repo owner and name along with the number assigned to the pull request. -- With authentification. -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid -- | A detailed pull request, which has much more information. This takes the -- repo owner and name along with the number assigned to the pull request. -- -- > pullRequest "thoughtbot" "paperclip" 562 pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) pullRequest = pullRequest' Nothing -- | Query a single pull request. -- See pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest pullRequestR user repo prid = query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] createPullRequest :: Auth -> Name Owner -> Name Repo -> CreatePullRequest -> IO (Either Error PullRequest) createPullRequest auth user repo cpr = executeRequest auth $ createPullRequestR user repo cpr -- | Create a pull request. -- See createPullRequestR :: Name Owner -> Name Repo -> CreatePullRequest -> Request 'RW PullRequest createPullRequestR user repo cpr = command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) updatePullRequest auth user repo prid epr = executeRequest auth $ updatePullRequestR user repo prid epr -- | Update a pull request. -- See updatePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> Request 'RW PullRequest updatePullRequestR user repo prid epr = command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. -- With authentification. -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. -- -- > pullRequestCommits "thoughtbot" "paperclip" 688 pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. -- With authentification. -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. -- -- > pullRequestFiles "thoughtbot" "paperclip" 688 pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Check if pull request has been merged. isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid -- | Query if a pull request has been merged. -- See isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> IO (Either Error MergeResult) mergePullRequest auth user repo prid commitMessage = executeRequest auth $ mergePullRequestR user repo prid commitMessage -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] buildCommitMessageMap :: Maybe Text -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] buildCommitMessageMap Nothing = object [] github-0.20/src/GitHub/Endpoints/PullRequests/0000755000000000000000000000000013352724157017500 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/PullRequests/Reviews.hs0000644000000000000000000001166013352724157021464 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews ( pullRequestReviewsR , pullRequestReviews , pullRequestReviews' , pullRequestReviewR , pullRequestReview , pullRequestReview' , pullRequestReviewCommentsR , pullRequestReviewCommentsIO , pullRequestReviewCommentsIO' , module GitHub.Data ) where import GitHub.Data import GitHub.Data.Id (Id) import GitHub.Internal.Prelude import GitHub.Request (Request, executeRequest', executeRequestMaybe) import Prelude () -- | List reviews for a pull request. -- See pullRequestReviewsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Review) pullRequestReviewsR owner repo prid = pagedQuery [ "repos" , toPathPart owner , toPathPart repo , "pulls" , toPathPart prid , "reviews" ] [] -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. -- -- > pullRequestReviews "thoughtbot" "paperclip" (Id 101) pullRequestReviews :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Review)) pullRequestReviews owner repo prid = executeRequest' $ pullRequestReviewsR owner repo prid FetchAll -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. With authentication. -- -- > pullRequestReviews' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) pullRequestReviews' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Review)) pullRequestReviews' auth owner repo pr = executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll -- | Query a single pull request review. -- see pullRequestReviewR :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> Request k Review pullRequestReviewR owner repo prid rid = query [ "repos" , toPathPart owner , toPathPart repo , "pulls" , toPathPart prid , "reviews" , toPathPart rid ] [] -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. -- -- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) pullRequestReview owner repo prid rid = executeRequest' $ pullRequestReviewR owner repo prid rid -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. With authentication. -- -- > pullRequestReview' (Just ("github-username", "github-password")) -- "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) pullRequestReview' auth owner repo prid rid = executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid -- | Query the comments for a single pull request review. -- see pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> Request k [ReviewComment] pullRequestReviewCommentsR owner repo prid rid = query [ "repos" , toPathPart owner , toPathPart repo , "pulls" , toPathPart prid , "reviews" , toPathPart rid , "comments" ] [] -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO owner repo prid rid = executeRequest' $ pullRequestReviewCommentsR owner repo prid rid -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. With authentication. -- -- > pullRequestReviewComments' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO' auth owner repo prid rid = executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid github-0.20/src/GitHub/Endpoints/PullRequests/Comments.hs0000644000000000000000000000354513352724157021630 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsIO, pullRequestCommentsR, pullRequestComment, pullRequestCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the comments on a pull request with the given ID. -- -- > pullRequestComments "thoughtbot" "factory_girl" (Id 256) pullRequestCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) pullRequestCommentsIO user repo prid = executeRequest' $ pullRequestCommentsR user repo prid FetchAll -- | List comments on a pull request. -- See pullRequestCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) pullRequestCommentsR 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] [] github-0.20/src/GitHub/Endpoints/Issues/0000755000000000000000000000000013352724157016303 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Issues/Events.hs0000644000000000000000000000624513352724157020112 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github issue events API, which is described on -- module GitHub.Endpoints.Issues.Events ( eventsForIssue, eventsForIssue', eventsForIssueR, eventsForRepo, eventsForRepo', eventsForRepoR, event, event', eventR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll -- | List events for an issue. -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueEvent) eventsForIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo FetchAll -- | List events for a repository. -- See eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueEvent) eventsForRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 event :: Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- -- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid -- | Query a single event. -- See eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent eventR user repo eid = query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] github-0.20/src/GitHub/Endpoints/Issues/Comments.hs0000644000000000000000000000775513352724157020442 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github issue comments API from -- . module GitHub.Endpoints.Issues.Comments ( comment, commentR, comments, commentsR, comments', createComment, createCommentR, deleteComment, deleteCommentR, editComment, editCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A specific comment, by ID. -- -- > comment "thoughtbot" "paperclip" 1468184 comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) comment user repo cid = executeRequest' $ commentR user repo cid -- | Query a single comment. -- See commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 comments :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid FetchAll -- | List comments on an issue. -- See commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a new comment. -- -- > createComment (User (user, password)) user repo issue -- > "some words" createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> Text -> IO (Either Error Comment) createComment auth user repo iss body = executeRequest auth $ createCommentR user repo iss body -- | Create a comment. -- See createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'RW Comment createCommentR user repo iss body = command Post parts (encode $ NewComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] -- | Edit a comment. -- -- > editComment (User (user, password)) user repo commentid -- > "new words" editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text -> IO (Either Error Comment) editComment auth user repo commid body = executeRequest auth $ editCommentR user repo commid body -- | Edit a comment. -- See editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment editCommentR user repo commid body = 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] github-0.20/src/GitHub/Endpoints/Issues/Labels.hs0000644000000000000000000002475313352724157020054 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for dealing with labels on Github issues as described on -- . module GitHub.Endpoints.Issues.Labels ( labelsOnRepo, labelsOnRepo', labelsOnRepoR, label, label', labelR, createLabel, createLabelR, updateLabel, updateLabelR, deleteLabel, deleteLabelR, labelsOnIssue, labelsOnIssue', labelsOnIssueR, addLabelsToIssue, addLabelsToIssueR, removeLabelFromIssue, removeLabelFromIssueR, replaceAllLabelsForIssue, replaceAllLabelsForIssueR, removeAllLabelsFromIssue, removeAllLabelsFromIssueR, labelsOnMilestone, labelsOnMilestone', labelsOnMilestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo using authentication. -- -- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip" labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll -- | List all labels for this repository. -- See labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] -- | A label by name. -- -- > label "thoughtbot" "paperclip" "bug" label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label = label' Nothing -- | A label by name using authentication. -- -- > label' (Just (User (user password))) "thoughtbot" "paperclip" "bug" label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label' auth user repo lbl = executeRequestMaybe auth $ labelR user repo lbl -- | Query a single label. -- See labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label -- -- > createLabel (User (user password)) "thoughtbot" "paperclip" "bug" "f29513" createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) createLabel auth user repo lbl color = executeRequest auth $ createLabelR user repo lbl color -- | Create a label. -- See createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel createLabelR user repo lbl color = command Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] -- | Update a label -- -- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" updateLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color -> IO (Either Error IssueLabel) updateLabel auth user repo oldLbl newLbl color = executeRequest auth $ updateLabelR user repo oldLbl newLbl color -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color -> Request 'RW IssueLabel updateLabelR user repo oldLbl newLbl color = command Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] -- | Delete a label -- -- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug" deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) deleteLabel auth user repo lbl = executeRequest auth $ deleteLabelR user repo lbl -- | Delete a label. -- 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 -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- -- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll -- | 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 (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] addLabelsToIssue :: Foldable f => Auth -> Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> IO (Either Error (Vector IssueLabel)) addLabelsToIssue auth user repo iid lbls = executeRequest auth $ addLabelsToIssueR user repo iid lbls -- | Add lables to an issue. -- See addLabelsToIssueR :: Foldable f => Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> Request 'RW (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = command Post paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove a label from an issue. -- -- > removeLabelFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) "bug" removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) removeLabelFromIssue auth user repo iid lbl = executeRequest auth $ removeLabelFromIssueR user repo iid lbl -- | Remove a label from an issue. -- See removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'RW () removeLabelFromIssueR user repo iid lbl = command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- -- > replaceAllLabelsForIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] replaceAllLabelsForIssue :: Foldable f => Auth -> Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> IO (Either Error (Vector IssueLabel)) replaceAllLabelsForIssue auth user repo iid lbls = executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls -- | Replace all labels on an issue. -- See -- -- Sending an empty list will remove all labels from the issue. replaceAllLabelsForIssueR :: Foldable f => Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> Request 'RW (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = command Put paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove all labels from an issue. -- -- > removeAllLabelsFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ()) removeAllLabelsFromIssue auth user repo iid = executeRequest auth $ removeAllLabelsFromIssueR user repo iid -- | Remove all labels from an issue. -- See removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'RW () removeAllLabelsFromIssueR user repo iid = command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone given the milestone ID using authentication. -- -- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2) labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll -- | Query labels for every issue in a milestone. -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] github-0.20/src/GitHub/Endpoints/Issues/Milestones.hs0000644000000000000000000000357113352724157020767 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The milestones API as described on -- . module GitHub.Endpoints.Issues.Milestones ( milestones, milestones', milestonesR, milestone, milestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All milestones in the repo. -- -- > milestones "thoughtbot" "paperclip" milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- -- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = executeRequestMaybe auth $ milestonesR user repo FetchAll -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) milestonesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- -- > milestone "thoughtbot" "paperclip" (Id 2) milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) milestone user repo mid = executeRequest' $ milestoneR user repo mid -- | Query a single milestone. -- See milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] github-0.20/src/GitHub/Endpoints/Users/0000755000000000000000000000000013352724157016131 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Users/Emails.hs0000644000000000000000000000302013352724157017672 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The user emails API as described on -- . module GitHub.Endpoints.Users.Emails ( currentUserEmails', currentUserEmailsR, currentUserPublicEmails', currentUserPublicEmailsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | List email addresses for the authenticated user. -- -- > currentUserEmails' (OAuth "token") currentUserEmails' :: Auth -> IO (Either Error (Vector Email)) currentUserEmails' auth = executeRequest auth $ currentUserEmailsR FetchAll -- | List email addresses. -- See currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) currentUserEmailsR = pagedQuery ["user", "emails"] [] -- | List public email addresses for the authenticated user. -- -- > currentUserPublicEmails' (OAuth "token") currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email)) currentUserPublicEmails' auth = executeRequest auth $ currentUserPublicEmailsR FetchAll -- | List public email addresses. -- See currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) currentUserPublicEmailsR = pagedQuery ["user", "public_emails"] [] github-0.20/src/GitHub/Endpoints/Users/Followers.hs0000644000000000000000000000301013352724157020433 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The user followers API as described on -- . module GitHub.Endpoints.Users.Followers ( usersFollowing, usersFollowedBy, usersFollowingR, usersFollowedByR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the users following the given user. -- -- > usersFollowing "mike-burns" usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowing user = executeRequest' $ usersFollowingR user FetchAll -- | List followers of a user. -- See usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowingR user = pagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowedBy user = executeRequest' $ usersFollowedByR user FetchAll -- | List users followed by another user. -- See usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowedByR user = pagedQuery ["users", toPathPart user, "following"] [] github-0.20/src/GitHub/Endpoints/Activity/0000755000000000000000000000000013352724157016624 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Activity/Events.hs0000644000000000000000000000202313352724157020421 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The events API as described on . module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, userEventsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import Prelude () -- | List repository events. -- See repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event) repositoryEventsR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "events"] [] -- | List user public events. -- See userEventsR :: Name User -> FetchCount -> Request 'RO (Vector Event) userEventsR user = pagedQuery ["users", toPathPart user, "events", "public"] [] github-0.20/src/GitHub/Endpoints/Activity/Watching.hs0000644000000000000000000000430313352724157020724 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo watching API as described on -- . module GitHub.Endpoints.Activity.Watching ( watchersFor, watchersFor', watchersForR, reposWatchedBy, reposWatchedBy', reposWatchedByR, module GitHub.Data, ) where import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- -- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo FetchAll -- | List watchers. -- See watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- -- > reposWatchedBy "croaky" reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- -- > reposWatchedBy' (Just (User (user, password))) "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = executeRequestMaybe auth $ reposWatchedByR user FetchAll -- | List repositories being watched. -- See reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = pagedQuery ["users", toPathPart user, "subscriptions"] [] github-0.20/src/GitHub/Endpoints/Activity/Starring.hs0000644000000000000000000000731713352724157020761 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo starring API as described on -- . module GitHub.Endpoints.Activity.Starring ( stargazersFor, stargazersForR, reposStarredBy, reposStarredByR, myStarred, myStarredR, myStarredAcceptStar, myStarredAcceptStarR, starRepo, starRepoR, unstarRepo, unstarRepoR, module GitHub.Data, ) where import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) stargazersFor auth user repo = executeRequestMaybe auth $ stargazersForR user repo FetchAll -- | List Stargazers. -- See stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = executeRequestMaybe auth $ reposStarredByR user FetchAll -- | List repositories being starred. -- See reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = pagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = executeRequest auth $ myStarredR FetchAll -- | All the repos starred by the authenticated user. -- See myStarredR :: FetchCount -> Request 'RA (Vector Repo) myStarredR = pagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) myStarredAcceptStar auth = executeRequest auth $ myStarredAcceptStarR FetchAll -- | All the repos starred by the authenticated user. -- See myStarredAcceptStarR :: FetchCount -> 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] github-0.20/src/GitHub/Endpoints/Gists/0000755000000000000000000000000013352724157016121 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Gists/Comments.hs0000644000000000000000000000257713352724157020255 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The loving comments people have left on Gists, described on -- . module GitHub.Endpoints.Gists.Comments ( commentsOn, commentsOnR, comment, gistCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the comments on a Gist, given the Gist ID. -- -- > commentsOn "1174060" commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) commentsOn gid = executeRequest' $ commentsOnR gid FetchAll -- | List comments on a gist. -- See commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = pagedQuery ["gists", toPathPart gid, "comments"] [] -- | A specific comment, by the comment ID. -- -- > comment (Id 62449) comment :: Id GistComment -> IO (Either Error GistComment) comment cid = executeRequest' $ gistCommentR cid -- | Query a single comment. -- See gistCommentR :: Id GistComment -> Request k GistComment gistCommentR cid = query ["gists", "comments", toPathPart cid] [] github-0.20/src/GitHub/Endpoints/Repos/0000755000000000000000000000000013352724157016120 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Repos/Contents.hs0000644000000000000000000001246013352724157020254 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Repo Contents API, as documented at -- module GitHub.Endpoints.Repos.Contents ( -- * Querying contents contentsFor, contentsFor', contentsForR, readmeFor, readmeFor', readmeForR, archiveFor, archiveFor', archiveForR, -- ** Create createFile, createFileR, -- ** Update updateFile, updateFileR, -- ** Delete deleteFile, deleteFileR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () import Data.Maybe (maybeToList) import qualified Data.Text.Encoding as TE import Network.URI (URI) -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- -- > contentsFor "thoughtbot" "paperclip" "README.md" contentsFor :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) contentsFor = contentsFor' Nothing -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- With Authentication -- -- > contentsFor' (Just (BasicAuth (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"] [] -- | 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 -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> CreateFile -> IO (Either Error ContentResult) createFile auth user repo body = executeRequest auth $ createFileR user repo body -- | Create a file. -- See createFileR :: Name Owner -> Name Repo -> CreateFile -> Request 'RW ContentResult createFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) -- | Update a file. updateFile :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> UpdateFile -> IO (Either Error ContentResult) updateFile auth user repo body = executeRequest auth $ updateFileR user repo body -- | Update a file. -- See updateFileR :: Name Owner -> Name Repo -> UpdateFile -> Request 'RW ContentResult updateFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) -- | Delete a file. deleteFile :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> DeleteFile -> IO (Either Error ()) deleteFile auth user repo body = executeRequest auth $ deleteFileR user repo body -- | Delete a file. -- See deleteFileR :: Name Owner -> Name Repo -> DeleteFile -> Request 'RW () deleteFileR user repo body = command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) github-0.20/src/GitHub/Endpoints/Repos/Webhooks.hs0000644000000000000000000001146013352724157020237 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The webhooks API, as described at -- -- module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories webhooksFor', webhooksForR, webhookFor', webhookForR, -- ** Create createRepoWebhook', createRepoWebhookR, -- ** Edit editRepoWebhook', editRepoWebhookR, -- ** Test testPushRepoWebhook', testPushRepoWebhookR, pingRepoWebhook', pingRepoWebhookR, -- ** Delete deleteRepoWebhook', deleteRepoWebhookR, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = executeRequest auth $ webhooksForR user repo FetchAll -- | List hooks. -- See webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = executeRequest auth $ webhookForR user repo hookId -- | Query single hook. -- See webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) createRepoWebhook' auth user repo hook = executeRequest auth $ createRepoWebhookR user repo hook -- | Create a hook. -- See createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) editRepoWebhook' auth user repo hookId hookEdit = executeRequest auth $ editRepoWebhookR user repo hookId hookEdit -- | Edit a hook. -- See editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) testPushRepoWebhook' auth user repo hookId = executeRequest auth $ testPushRepoWebhookR user repo hookId -- | Test a push hook. -- See testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool 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) pingRepoWebhook' auth user repo hookId = executeRequest auth $ pingRepoWebhookR user repo hookId -- | Ping a hook. -- See pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool pingRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) deleteRepoWebhook' auth user repo hookId = executeRequest auth $ deleteRepoWebhookR user repo hookId -- | Delete a hook. -- See deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () deleteRepoWebhookR user repo hookId = command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe Text -> Paths createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] github-0.20/src/GitHub/Endpoints/Repos/Comments.hs0000644000000000000000000000655713352724157020256 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Comments ( commentsFor, commentsFor', commentsForR, commitCommentsFor, commitCommentsFor', commitCommentsForR, commitCommentFor, commitCommentFor', commitCommentForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor = commentsFor' Nothing -- | All the comments on a Github repo. -- With authentication. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor' auth user repo = executeRequestMaybe auth $ commentsForR user repo FetchAll -- | List commit comments for a repository. -- See commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor = commitCommentsFor' Nothing -- | Just the comments on a specific SHA for a given Github repo. -- With authentication. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor' auth user repo sha = executeRequestMaybe auth $ commitCommentsForR user repo sha FetchAll -- | List comments for a single commit. -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor = commitCommentFor' Nothing -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor' auth user repo cid = executeRequestMaybe auth $ commitCommentForR user repo cid -- | Query a single commit comment. -- See commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment commitCommentForR user repo cid = query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] github-0.20/src/GitHub/Endpoints/Repos/Collaborators.hs0000644000000000000000000000453213352724157021266 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo collaborators API as described on -- . module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOn, collaboratorsOn', collaboratorsOnR, isCollaboratorOn, isCollaboratorOnR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = executeRequestMaybe auth $ collaboratorsOnR user repo FetchAll -- | List collaborators. -- See collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. -- -- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" isCollaboratorOn :: Maybe Auth -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> IO (Either Error Bool) isCollaboratorOn auth user repo coll = executeRequestMaybe auth $ isCollaboratorOnR user repo coll -- | Check if a user is a collaborator. -- See isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> Request k Bool isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] github-0.20/src/GitHub/Endpoints/Repos/Statuses.hs0000644000000000000000000000520613352724157020272 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo statuses API as described on -- . module GitHub.Endpoints.Repos.Statuses ( createStatus, createStatusR, statusesFor, statusesForR, statusFor, statusForR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Create a new status -- -- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" -- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) createStatus auth owner repo sha ns = executeRequest auth $ createStatusR owner repo sha ns -- | Create a new status -- See createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status createStatusR owner repo sha = command Post parts . encode where parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] -- | All statuses for a commit -- -- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" -- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) statusesFor auth user repo sha = executeRequest auth $ statusesForR user repo sha FetchAll -- | All statuses for a commit -- See statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) statusesForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] -- | The combined status for a specific commit -- -- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" -- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) statusFor auth user repo sha = executeRequest auth $ statusForR user repo sha -- | The combined status for a specific commit -- See statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus statusForR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] github-0.20/src/GitHub/Endpoints/Repos/Releases.hs0000644000000000000000000001036113352724157020220 0ustar0000000000000000-- The Release API, as described at -- . module GitHub.Endpoints.Repos.Releases ( releases, releases', releasesR, release, release', releaseR, latestRelease, latestRelease', latestReleaseR, releaseByTagName, releaseByTagName', releaseByTagNameR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All releases for the given repo. -- -- > releases "calleerlandsson" "pick" releases :: Name Owner -> Name Repo -> IO (Either Error (Vector Release)) releases = releases' Nothing -- | All releases for the given repo with authentication. -- -- > releases' (Just (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 -} github-0.20/src/GitHub/Endpoints/Repos/DeployKeys.hs0000644000000000000000000000531713352724157020552 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Todd Mohney -- -- The deploy keys API, as described at -- module GitHub.Endpoints.Repos.DeployKeys ( -- * Querying deploy keys deployKeysFor', deployKeysForR, deployKeyFor', deployKeyForR, -- ** Create createRepoDeployKey', createRepoDeployKeyR, -- ** Delete deleteRepoDeployKey', deleteRepoDeployKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Querying deploy keys. deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) deployKeysFor' auth user repo = executeRequest auth $ deployKeysForR user repo FetchAll -- | Querying deploy keys. -- See deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] -- | Querying a deploy key deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) deployKeyFor' auth user repo keyId = executeRequest auth $ deployKeyForR user repo keyId -- | Querying a deploy key. -- See deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] -- | Create a deploy key createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) createRepoDeployKey' auth user repo key = executeRequest auth $ createRepoDeployKeyR user repo key -- | Create a deploy key. -- See . createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) deleteRepoDeployKey' auth user repo keyId = executeRequest auth $ deleteRepoDeployKeyR user repo keyId -- | Delete a deploy key. -- See deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () deleteRepoDeployKeyR user repo keyId = command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty github-0.20/src/GitHub/Endpoints/Repos/Deployments.hs0000644000000000000000000000427013352724157020762 0ustar0000000000000000-- | The deployments API, as described at module GitHub.Endpoints.Repos.Deployments ( deploymentsWithOptionsForR , createDeploymentR , deploymentStatusesForR , createDeploymentStatusR , module GitHub.Data ) where import Control.Arrow (second) import Data.Vector (Vector) import GitHub.Data import GitHub.Internal.Prelude -- | List deployments. -- See deploymentsWithOptionsForR :: FromJSON a => Name Owner -> Name Repo -> FetchCount -> [DeploymentQueryOption] -> Request 'RA (Vector (Deployment a)) deploymentsWithOptionsForR owner repo limit opts = pagedQuery (deployPaths owner repo) (map (second Just . renderDeploymentQueryOption) opts) limit -- | Create a deployment. -- See createDeploymentR :: ( ToJSON a , FromJSON a ) => Name Owner -> Name Repo -> CreateDeployment a -> Request 'RW (Deployment a) createDeploymentR owner repo = command Post (deployPaths owner repo) . encode -- | List deployment statuses. -- See deploymentStatusesForR :: Name Owner -> Name Repo -> Id (Deployment a) -> FetchCount -> Request 'RA (Vector DeploymentStatus) deploymentStatusesForR owner repo deploy = pagedQuery (statusesPaths owner repo deploy) [] -- | Create a deployment status. -- See createDeploymentStatusR :: Name Owner -> Name Repo -> Id (Deployment a) -> CreateDeploymentStatus -> Request 'RW DeploymentStatus createDeploymentStatusR owner repo deploy = command Post (statusesPaths owner repo deploy) . encode statusesPaths :: Name Owner -> Name Repo -> Id (Deployment a) -> Paths statusesPaths owner repo deploy = deployPaths owner repo ++ [toPathPart deploy, "statuses"] deployPaths :: Name Owner -> Name Repo -> Paths deployPaths owner repo = ["repos", toPathPart owner, toPathPart repo, "deployments"] github-0.20/src/GitHub/Endpoints/Repos/Forks.hs0000644000000000000000000000234213352724157017541 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Hot forking action, as described at -- . module GitHub.Endpoints.Repos.Forks ( forksFor, forksFor', forksForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the repos that are forked off the given repo. -- -- > forksFor "thoughtbot" "paperclip" forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- -- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = executeRequestMaybe auth $ forksForR user repo FetchAll -- | List forks. -- See forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) forksForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] github-0.20/src/GitHub/Endpoints/Repos/Commits.hs0000644000000000000000000001161213352724157020070 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), commitsFor, commitsFor', commitsForR, commitsWithOptionsFor, commitsWithOptionsFor', commitsWithOptionsForR, commit, commit', commitR, diff, diff', diffR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as TE renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- -- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] -- | List commits on a repository. -- See commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- | The commit history for a repo, with commits filtered to satisfy a list of -- query options. -- With authentication. -- -- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts -- | List commits on a repository. -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR user repo limit opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts -- | Details on a specific SHA1 for a repo. -- -- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit = commit' Nothing -- | Details on a specific SHA1 for a repo. -- With authentication. -- -- > commit (Just $ BasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit' auth user repo sha = executeRequestMaybe auth $ commitR user repo sha -- | Query a single commit. -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff = diff' Nothing -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff' auth user repo base headref = executeRequestMaybe auth $ diffR user repo base headref -- | Compare two commits. -- See diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diffR user repo base headref = query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base <> "..." <> toPathPart headref] [] github-0.20/src/GitHub/Endpoints/Organizations/0000755000000000000000000000000013352724157017657 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/Organizations/Members.hs0000644000000000000000000000621113352724157021605 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The organization members API as described on -- . module GitHub.Endpoints.Organizations.Members ( membersOf, membersOf', membersOfR, membersOfWithR, isMemberOf, isMemberOf', isMemberOfR, orgInvitationsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the users who are members of the specified organization, -- | with or without authentication. -- -- > membersOf' (Just $ OAuth "token") "thoughtbot" membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = executeRequestMaybe auth $ membersOfR org FetchAll -- | All the users who are members of the specified organization, -- | without authentication. -- -- > membersOf "thoughtbot" membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) membersOfR organization = pagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) membersOfWithR org f r = pagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] where f' = case f of OrgMemberFilter2faDisabled -> "2fa_disabled" OrgMemberFilterAll -> "all" r' = case r of OrgMemberRoleAll -> "all" OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" -- | Check if a user is a member of an organization, -- | with or without authentication. -- -- > isMemberOf' (Just $ OAuth "token") "phadej" "haskell-infra" isMemberOf' :: Maybe Auth -> Name User -> Name Organization -> IO (Either Error Bool) isMemberOf' auth user org = executeRequestMaybe auth $ isMemberOfR user org -- | Check if a user is a member of an organization, -- | without authentication. -- -- > isMemberOf "phadej" "haskell-infra" isMemberOf :: Name User -> Name Organization -> IO (Either Error Bool) isMemberOf = isMemberOf' Nothing -- | Check if a user is a member of an organization. -- -- See isMemberOfR :: Name User -> Name Organization -> Request k Bool isMemberOfR user org = StatusQuery statusOnlyOk $ Query [ "orgs", toPathPart org, "members", toPathPart user ] [] -- | List pending organization invitations -- -- See orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation) orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] [] github-0.20/src/GitHub/Endpoints/Organizations/Teams.hs0000644000000000000000000002027013352724157021265 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Owner teams API as described on -- . module GitHub.Endpoints.Organizations.Teams ( teamsOf, teamsOf', teamsOfR, teamInfoFor, teamInfoFor', teamInfoForR, createTeamFor', createTeamForR, editTeam', editTeamR, deleteTeam', deleteTeamR, listTeamMembersR, listTeamRepos, listTeamRepos', listTeamReposR, addOrUpdateTeamRepo', addOrUpdateTeamRepoR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, addTeamMembershipFor', addTeamMembershipForR, deleteTeamMembershipFor', deleteTeamMembershipForR, listTeamsCurrent', listTeamsCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. -- When unauthenticated, lists only public teams for an Owner. -- -- > teamsOf' (Just $ OAuth "token") "thoughtbot" teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = executeRequestMaybe auth $ teamsOfR org FetchAll -- | List the public teams of an Owner. -- -- > teamsOf "thoughtbot" teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) teamsOfR org = pagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- With authentication -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) teamInfoFor' auth tid = executeRequestMaybe auth $ teamInfoForR tid -- | The information for a single team, by team id. -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor :: Id Team -> IO (Either Error Team) teamInfoFor = teamInfoFor' Nothing -- | Query team. -- See teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = query ["teams", toPathPart tid] [] -- | Create a team under an Owner -- -- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull) createTeamFor' :: Auth -> Name Organization -> CreateTeam -> IO (Either Error Team) createTeamFor' auth org cteam = executeRequest auth $ createTeamForR org cteam -- | Create team. -- See createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = command Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- -- > editTeamFor' editTeam' :: Auth -> Id Team -> EditTeam -> IO (Either Error Team) editTeam' auth tid eteam = executeRequest auth $ editTeamR tid eteam -- | Edit team. -- See editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = command Patch ["teams", toPathPart tid] (encode eteam) -- | Delete a team, by id. -- -- > deleteTeam' (OAuth "token") 1010101 deleteTeam' :: Auth -> Id Team -> IO (Either Error ()) deleteTeam' auth tid = executeRequest auth $ deleteTeamR tid -- | Delete team. -- -- See deleteTeamR :: Id Team -> Request 'RW () deleteTeamR tid = command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) listTeamMembersR tid r = pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of TeamMemberRoleAll -> "all" TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" -- | The repositories of a single team, by team id. -- With authentication -- -- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll -- | Query team repositories. -- See listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) listTeamReposR tid = pagedQuery ["teams", toPathPart tid, "repos"] [] -- | Retrieve repositories for a team. -- -- > listTeamRepos (GitHub.mkTeamId team_id) listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) listTeamRepos = listTeamRepos' Nothing -- | Add a repository to a team or update the permission on the repository. -- -- > addOrUpdateTeamRepo' (OAuth "token") 1010101 "mburns" (Just PermissionPull) addOrUpdateTeamRepo' :: Auth -> Id Team -> Name Organization -> Name Repo -> Permission -> IO (Either Error ()) addOrUpdateTeamRepo' auth tid org repo permission = executeRequest auth $ addOrUpdateTeamRepoR tid org repo permission -- | Add or update a team repository. -- See addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> 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 -- -- > 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 -> Request 'RW () deleteTeamMembershipForR tid user = command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- -- > listTeamsCurrent' (OAuth "token") listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) listTeamsCurrentR = pagedQuery ["user", "teams"] [] github-0.20/src/GitHub/Endpoints/GitData/0000755000000000000000000000000013352724157016345 5ustar0000000000000000github-0.20/src/GitHub/Endpoints/GitData/Trees.hs0000644000000000000000000000431213352724157017763 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module GitHub.Endpoints.GitData.Trees ( tree, tree', treeR, nestedTree, nestedTree', nestedTreeR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A tree for a SHA1. -- -- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree' auth user repo sha = executeRequestMaybe auth $ treeR user repo sha -- | A tree for a SHA1. -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree = tree' Nothing -- | Query a Tree. -- See treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] -- | A recursively-nested tree for a SHA1. -- -- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree' auth user repo sha = executeRequestMaybe auth $ nestedTreeR user repo sha -- | A recursively-nested tree for a SHA1. -- -- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree = nestedTree' Nothing -- | Query a Tree Recursively. -- See nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] github-0.20/src/GitHub/Endpoints/GitData/References.hs0000644000000000000000000000667213352724157020775 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . module GitHub.Endpoints.GitData.References ( reference, reference', referenceR, references, references', referencesR, createReference, createReferenceR, namespacedReferences, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A single reference by the ref name. -- -- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference' auth user repo ref = executeRequestMaybe auth $ referenceR user repo ref -- | A single reference by the ref name. -- -- > reference "mike-burns" "github" "heads/master" reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference = reference' Nothing -- | Query a reference. -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- -- > references "mike-burns" "github" references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references' auth user repo = executeRequestMaybe auth $ referencesR user repo FetchAll -- | The history of references for a repo. -- -- > references "mike-burns" "github" references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references = references' Nothing -- | Query all References. -- See referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) createReference auth user repo newRef = executeRequest auth $ createReferenceR user repo newRef -- | Create a reference. -- See createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" namespacedReferences :: Name Owner -> Name Repo -> Text -> IO (Either Error [GitReference]) namespacedReferences user repo namespace = executeRequest' $ namespacedReferencesR user repo namespace -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] namespacedReferencesR user repo namespace = query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] github-0.20/src/GitHub/Endpoints/GitData/Blobs.hs0000644000000000000000000000236513352724157017750 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for dealing with git blobs from Github repos, as described in -- . module GitHub.Endpoints.GitData.Blobs ( blob, blob', blobR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Query a blob by SHA1. -- -- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob' auth user repo sha = executeRequestMaybe auth $ blobR user repo sha -- | Query a blob by SHA1. -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob = blob' Nothing -- | Query a blob. -- See blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob blobR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] github-0.20/src/GitHub/Endpoints/GitData/Commits.hs0000644000000000000000000000201713352724157020314 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for underlying git commits of a Github repo, as described on -- . module GitHub.Endpoints.GitData.Commits ( commit, gitCommitR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A single commit, by SHA1. -- -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) commit user repo sha = executeRequest' $ gitCommitR user repo sha -- | Query a commit. -- See gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit gitCommitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] github-0.20/fixtures/0000755000000000000000000000000013352724157012765 5ustar0000000000000000github-0.20/fixtures/issue-search.json0000644000000000000000000001314013352724157016252 0ustar0000000000000000{ "total_count": 2, "incomplete_results": false, "items": [ { "url": "https://api.github.com/repos/phadej/github/issues/130", "labels_url": "https://api.github.com/repos/phadej/github/issues/130/labels{/name}", "comments_url": "https://api.github.com/repos/phadej/github/issues/130/comments", "events_url": "https://api.github.com/repos/phadej/github/issues/130/events", "html_url": "https://github.com/phadej/github/pull/130", "id": 123898390, "number": 130, "title": "Make test runner more robust", "user": { "login": "phadej", "id": 51087, "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "labels": [ ], "state": "closed", "locked": false, "assignee": null, "assignees": [], "milestone": null, "comments": 0, "created_at": "2015-12-25T21:37:39Z", "updated_at": "2015-12-26T08:57:52Z", "closed_at": "2015-12-25T23:32:12Z", "pull_request": { "url": "https://api.github.com/repos/phadej/github/pulls/130", "html_url": "https://github.com/phadej/github/pull/130", "diff_url": "https://github.com/phadej/github/pull/130.diff", "patch_url": "https://github.com/phadej/github/pull/130.patch" }, "body": "As they use access token, it's highly unlikely it will be rate limited. ATM there's only one request per test job. i.e. travis could be re-enabled.\r\n\r\nExample run https://travis-ci.org/phadej/github/builds/98815089\r\nSome tests are pending as secret is made for this `jwiegley/github` repository.", "score": 0.75566536 }, { "url": "https://api.github.com/repos/phadej/github/issues/127", "labels_url": "https://api.github.com/repos/phadej/github/issues/127/labels{/name}", "comments_url": "https://api.github.com/repos/phadej/github/issues/127/comments", "events_url": "https://api.github.com/repos/phadej/github/issues/127/events", "html_url": "https://github.com/phadej/github/issues/127", "id": 119694665, "number": 127, "title": "Decouple request creation from execution", "user": { "login": "phadej", "id": 51087, "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "labels": [ ], "state": "open", "locked": false, "assignee": null, "assignees": [], "milestone": null, "comments": 2, "created_at": "2015-12-01T11:09:03Z", "updated_at": "2015-12-25T19:15:33Z", "closed_at": null, "body": "After working with this API, and making few others, I found that separating request creation and execution is better (i.e. more flexible) design.\r\n\r\nNow one cannot use different network client or add new endpoints.\r\n\r\nShorly\r\n\r\n```hs\r\n-- New stuff:\r\ndata GithubRequest a = GithubRequestGet Url\r\n | ...\r\n\r\n-- or alternatively\r\ndata GithubRequest a where\r\n GithubRequestGet :: Url -> GithubRequest a\r\n GithubRequestMultiGet :: Url -> GithubRequest [a]\r\n\r\nexecGithubRequest :: FromJSON a => GithubRequest a -> IO (Either Error a)\r\nexecGithubRequest' :: FromJSON a => Maybe GithubAuth -> GithubRequest a -> IO (Either Error a)\r\n\r\npublicOrganizationForRequest :: String -> GithubRequest [SimpleOrganisation]\r\npublicOrganizationForRequest org = GithubRequestGet ...\r\n\r\n-- Old IO methods become:\r\npublicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor = execGithubRequest . publicOrganizationForRequest\r\n\r\npublicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor' auth = execGithubRequest' auth . publicOrganizationForRequest\r\n```\r\n\r\nHow does this sound? I can make a refactoring, it's quite straight-forward.", "score": 0.7265285 } ] } github-0.20/fixtures/members-list.json0000644000000000000000000000170413352724157016265 0ustar0000000000000000[ { "login": "octocat", "id": 1, "avatar_url": "https://github.com/images/error/octocat_happy.gif", "gravatar_id": "", "url": "https://api.github.com/users/octocat", "html_url": "https://github.com/octocat", "followers_url": "https://api.github.com/users/octocat/followers", "following_url": "https://api.github.com/users/octocat/following{/other_user}", "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", "organizations_url": "https://api.github.com/users/octocat/orgs", "repos_url": "https://api.github.com/users/octocat/repos", "events_url": "https://api.github.com/users/octocat/events{/privacy}", "received_events_url": "https://api.github.com/users/octocat/received_events", "type": "User", "site_admin": false } ] github-0.20/fixtures/user-organizations.json0000644000000000000000000000032213352724157017520 0ustar0000000000000000[ { "login": "github", "id": 1, "url": "https://api.github.com/orgs/github", "avatar_url": "https://github.com/images/error/octocat_happy.gif", "description": "A great organization" } ] github-0.20/fixtures/user.json0000644000000000000000000000244313352724157014641 0ustar0000000000000000{ "login": "mike-burns", "id": 4550, "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3", "gravatar_id": "", "url": "https://api.github.com/users/mike-burns", "html_url": "https://github.com/mike-burns", "followers_url": "https://api.github.com/users/mike-burns/followers", "following_url": "https://api.github.com/users/mike-burns/following{/other_user}", "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}", "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions", "organizations_url": "https://api.github.com/users/mike-burns/orgs", "repos_url": "https://api.github.com/users/mike-burns/repos", "events_url": "https://api.github.com/users/mike-burns/events{/privacy}", "received_events_url": "https://api.github.com/users/mike-burns/received_events", "type": "User", "site_admin": false, "name": "Mike Burns", "company": "thoughtbot", "blog": "http://mike-burns.com/", "location": "Stockholm, Sweden", "email": "mburns@thoughtbot.com", "hireable": true, "bio": null, "public_repos": 35, "public_gists": 32, "followers": 171, "following": 0, "created_at": "2008-04-03T17:54:24Z", "updated_at": "2015-10-02T16:53:25Z" } github-0.20/fixtures/pull-request-opened.json0000644000000000000000000003662713352724157017610 0ustar0000000000000000{ "url": "https://api.github.com/repos/phadej/github/pulls/9", "id": 144079630, "html_url": "https://github.com/phadej/github/pull/9", "diff_url": "https://github.com/phadej/github/pull/9.diff", "patch_url": "https://github.com/phadej/github/pull/9.patch", "issue_url": "https://api.github.com/repos/phadej/github/issues/9", "number": 9, "state": "open", "locked": false, "title": "Fetch my pull requests", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "body": "", "created_at": "2017-10-01T17:22:12Z", "updated_at": "2017-10-01T17:22:12Z", "closed_at": null, "merged_at": null, "merge_commit_sha": null, "assignee": null, "assignees": [ ], "milestone": null, "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", "head": { "label": "phadej:fetch-my-pull-requests", "ref": "fetch-my-pull-requests", "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "base": { "label": "phadej:master", "ref": "master", "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "_links": { "self": { "href": "https://api.github.com/repos/phadej/github/pulls/9" }, "html": { "href": "https://github.com/phadej/github/pull/9" }, "issue": { "href": "https://api.github.com/repos/phadej/github/issues/9" }, "comments": { "href": "https://api.github.com/repos/phadej/github/issues/9/comments" }, "review_comments": { "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" }, "review_comment": { "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" }, "commits": { "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" }, "statuses": { "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" } }, "author_association": "OWNER", "merged": false, "mergeable": null, "rebaseable": null, "mergeable_state": "unknown", "merged_by": null, "comments": 0, "review_comments": 0, "maintainer_can_modify": false, "commits": 6, "additions": 363, "deletions": 48, "changed_files": 19 } github-0.20/fixtures/pull-request-review-requested.json0000644000000000000000000004260513352724157021627 0ustar0000000000000000{ "url": "https://api.github.com/repos/phadej/github/pulls/9", "id": 144079630, "html_url": "https://github.com/phadej/github/pull/9", "diff_url": "https://github.com/phadej/github/pull/9.diff", "patch_url": "https://github.com/phadej/github/pull/9.patch", "issue_url": "https://api.github.com/repos/phadej/github/issues/9", "number": 9, "state": "open", "locked": false, "title": "Fetch my pull requests", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "body": "", "created_at": "2017-10-01T17:22:12Z", "updated_at": "2017-10-01T17:22:12Z", "closed_at": null, "merged_at": null, "merge_commit_sha": null, "assignee": null, "assignees": [ { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false } ], "requested_reviewers": [ { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false } ], "milestone": null, "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", "head": { "label": "phadej:fetch-my-pull-requests", "ref": "fetch-my-pull-requests", "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "base": { "label": "phadej:master", "ref": "master", "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "_links": { "self": { "href": "https://api.github.com/repos/phadej/github/pulls/9" }, "html": { "href": "https://github.com/phadej/github/pull/9" }, "issue": { "href": "https://api.github.com/repos/phadej/github/issues/9" }, "comments": { "href": "https://api.github.com/repos/phadej/github/issues/9/comments" }, "review_comments": { "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" }, "review_comment": { "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" }, "commits": { "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" }, "statuses": { "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" } }, "author_association": "OWNER", "merged": false, "mergeable": null, "rebaseable": null, "mergeable_state": "unknown", "merged_by": null, "comments": 0, "review_comments": 0, "maintainer_can_modify": false, "commits": 6, "additions": 363, "deletions": 48, "changed_files": 19 } github-0.20/fixtures/list-teams.json0000644000000000000000000000053713352724157015747 0ustar0000000000000000[ { "id": 1, "url": "https://api.github.com/teams/1", "name": "Justice League", "slug": "justice-league", "description": "A great team.", "privacy": "closed", "permission": "admin", "members_url": "https://api.github.com/teams/1/members{/member}", "repositories_url": "https://api.github.com/teams/1/repos" } ] github-0.20/spec/0000755000000000000000000000000013352724157012046 5ustar0000000000000000github-0.20/spec/Spec.hs0000644000000000000000000000005413352724157013273 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} github-0.20/spec/GitHub/0000755000000000000000000000000013352724157013230 5ustar0000000000000000github-0.20/spec/GitHub/UsersSpec.hs0000644000000000000000000000563313352724157015507 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isLeft, isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified GitHub import GitHub.Data (Auth (..), Organization (..), User (..), fromOwner) import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', userInfoFor') import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) import GitHub.Request (executeRequest) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a fromLeftS :: Show b => Either a b -> a fromLeftS (Left b) = b fromLeftS (Right a) = error $ "Expected a Left and got a RIght" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "userInfoFor" $ do it "decodes user json" $ do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "catches http exceptions" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist" userInfo `shouldSatisfy` isLeft it "should fail for organization" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "haskell" userInfo `shouldSatisfy` isLeft describe "ownerInfoFor" $ do it "works for users and organizations" $ withAuth $ \auth -> do a <- executeRequest auth $ ownerInfoForR "haskell" b <- executeRequest auth $ ownerInfoForR "phadej" a `shouldSatisfy` isRight b `shouldSatisfy` isRight (organizationLogin . fromRightS . fromOwner . fromRightS $ a) `shouldBe` "haskell" (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' auth userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do us <- executeRequest auth $ usersFollowingR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do us <- executeRequest auth $ usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight github-0.20/spec/GitHub/PullRequestReviewsSpec.hs0000644000000000000000000000175613352724157020242 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.PullRequestReviewsSpec where import qualified GitHub import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat import Data.Either.Compat (isRight) import Data.Foldable (for_) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) withAuth :: (GitHub.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (GitHub.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestReviewsR" $ do it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do cs <- GitHub.executeRequest auth $ GitHub.pullRequestReviewsR owner repo prid GitHub.FetchAll cs `shouldSatisfy` isRight where prs = [("phadej", "github", Id 268)] github-0.20/spec/GitHub/ReposSpec.hs0000644000000000000000000000337613352724157015500 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where import GitHub (Auth (..), Repo (..), RepoPublicity (..), executeRequest, repositoryR) import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.HashMap.Strict as HM fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do er <- executeRequest auth $ repositoryR "phadej" "github" er `shouldSatisfy` isRight let Right r = er -- https://github.com/phadej/github/pull/219 repoDefaultBranch r `shouldBe` Just "master" describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do cs <- currentUserRepos auth RepoPublicityAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do cs <- userRepos' (Just auth) "phadej" RepoPublicityAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do ls <- languagesFor' (Just auth) "phadej" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" github-0.20/spec/GitHub/OrganizationsSpec.hs0000644000000000000000000000367613352724157017242 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where import GitHub.Auth (Auth (..)) import GitHub.Data (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) import GitHub.Endpoints.Organizations (publicOrganizationsFor') import GitHub.Endpoints.Organizations.Members (membersOf') import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "publicOrganizationsFor'" $ do it "decodes simple organization json" $ do let orgs = eitherDecodeStrict $(embedFile "fixtures/user-organizations.json") simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" it "returns information about the user's organizations" $ withAuth $ \auth -> do orgs <- publicOrganizationsFor' (Just auth) "mike-burns" orgs `shouldSatisfy` isRight describe "teamsOf" $ do it "parse" $ do let ts = eitherDecodeStrict $(embedFile "fixtures/list-teams.json") simpleTeamName (head $ fromRightS ts) `shouldBe` "Justice League" describe "membersOf" $ do it "parse" $ do let ms = eitherDecodeStrict $(embedFile "fixtures/members-list.json") simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" it "works" $ withAuth $ \auth -> do ms <- membersOf' (Just auth) "haskell" ms `shouldSatisfy` isRight github-0.20/spec/GitHub/EventsSpec.hs0000644000000000000000000000225613352724157015650 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.EventsSpec where import Data.Either (isRight) import Data.String (fromString) import Prelude () import Prelude.Compat import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, shouldSatisfy, pendingWith) import qualified GitHub import GitHub.Data (Auth(..)) fromRightS :: Show a => Either a b -> b fromRightS (Left xs) = error $ "Should be Right" ++ show xs fromRightS (Right xs) = xs withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "repositoryEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ GitHub.repositoryEventsR "phadej" "github" 1 describe "userEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 where shouldSucceed f = withAuth $ \auth -> do cs <- GitHub.executeRequest auth $ f cs `shouldSatisfy` isRight length (fromRightS cs) `shouldSatisfy` (> 1) github-0.20/spec/GitHub/RateLimitSpec.hs0000644000000000000000000000162313352724157016273 0ustar0000000000000000{-# 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 github-0.20/spec/GitHub/CommitsSpec.hs0000644000000000000000000000441713352724157016020 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) import Data.List (nub, sort) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do cs <- commitsFor' (Just auth) "phadej" "github" cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) let hashes = sort $ map commitSha $ V.toList cs' hashes `shouldBe` nub hashes describe "diff" $ do it "works" $ withAuth $ \auth -> do cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits forM_ pairs $ \(a, b) -> do d <- executeRequest auth $ diffR "phadej" "github" (commitSha a) (commitSha b) d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight github-0.20/spec/GitHub/SearchSpec.hs0000644000000000000000000000423213352724157015605 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.SearchSpec where import Prelude () import Prelude.Compat import Data.Aeson (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V import GitHub.Data (Auth (..), Issue (..), IssueState (..), mkId) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "searchIssues" $ do it "decodes issue search response JSON" $ do let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issue-search.json") :: SearchResult Issue searchResultTotalCount searchIssuesResult `shouldBe` 2 let issues = searchResultResults searchIssuesResult V.length issues `shouldBe` 2 let issue1 = issues V.! 0 issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 issueNumber issue1 `shouldBe` 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 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` StateOpen it "performs an issue search via the API" $ withAuth $ \auth -> do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" issues <- searchResultResults . fromRightS <$> searchIssues' (Just auth) query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 github-0.20/spec/GitHub/PullRequestsSpec.hs0000644000000000000000000000633113352724157017052 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where import qualified GitHub import GitHub.Data.Id (Id (Id)) 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 :: (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 "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ 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 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") , ("phadej", "github") , ("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") github-0.20/spec/GitHub/ActivitySpec.hs0000644000000000000000000000266713352724157016206 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) import GitHub.Endpoints.Activity.Watching (watchersForR) import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do it "works" $ withAuth $ \auth -> do cs <- executeRequest auth $ myStarredAcceptStarR (GitHub.FetchAtLeast 31) cs `shouldSatisfy` isRight fromRightS cs `shouldSatisfy` (\xs -> V.length xs > 30) github-0.20/spec/GitHub/IssuesSpec.hs0000644000000000000000000000217413352724157015656 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.IssuesSpec where import qualified GitHub import Prelude () import Prelude.Compat import Data.Either.Compat (isRight) import Data.Foldable (for_) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (GitHub.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (GitHub.OAuth $ fromString token) spec :: Spec spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll cs `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") , ("haskell", "cabal") ] github-0.20/spec/GitHub/ReleasesSpec.hs0000644000000000000000000000370113352724157016143 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ReleasesSpec where import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Releases (Release (..), latestReleaseR, releaseByTagNameR, releaseR, releasesR) import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do let v154Id = GitHub.mkId (Proxy :: Proxy Release) 5254449 v154Text = "v1.5.4" describe "releasesR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ releasesR "calleerlandsson" "pick" GitHub.FetchAll rs `shouldSatisfy` isRight V.length (fromRightS rs) `shouldSatisfy` (> 14) describe "releaseR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ releaseR "calleerlandsson" "pick" v154Id rs `shouldSatisfy` isRight releaseTagName (fromRightS rs)`shouldBe` v154Text describe "latestReleaseR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ latestReleaseR "calleerlandsson" "pick" rs `shouldSatisfy` isRight describe "releaseByTagNameR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ releaseByTagNameR "calleerlandsson" "pick" v154Text rs `shouldSatisfy` isRight releaseId (fromRightS rs)`shouldBe` v154Id