github 0.18 → 0.19

raw patch · 18 files changed

+427/−94 lines, 18 filesdep ~aesondep ~basedep ~base-compatPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, base, base-compat, exceptions, http-types, mtl, time, transformers-compat

API changes (from Hackage documentation)

Files

• CHANGELOG.md +37/−12
• github.cabal +40/−33
• spec/GitHub/PullRequestsSpec.hs +8/−0
• src/GitHub.hs +15/−1
• src/GitHub/Data.hs +4/−0
• src/GitHub/Data/Definitions.hs +2/−2
• src/GitHub/Data/Email.hs +39/−0
• src/GitHub/Data/Invitation.hs +57/−0
• src/GitHub/Data/Issues.hs +61/−39
• src/GitHub/Data/Options.hs +3/−0
• src/GitHub/Data/PullRequests.hs +1/−1
• src/GitHub/Data/Repos.hs +11/−0
• src/GitHub/Data/Request.hs +8/−1
• src/GitHub/Endpoints/Organizations/Members.hs +32/−0
• src/GitHub/Endpoints/Repos.hs +2/−2
• src/GitHub/Endpoints/Repos/Contents.hs +30/−0
• src/GitHub/Endpoints/Users/Emails.hs +45/−0
• src/GitHub/Request.hs +32/−3

@@ -1,4 +1,27 @@-Changes for 0.18+## 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.@@ -12,13 +35,15 @@ - Add requested reviewers field to pull request records.   [#292](https://github.com/phadej/github/pull/292) -Changes for 0.17.0+## Changes for 0.17.0+ - Add `Ord Request` instance - Repository contents - Repository starring endpoints - Pull Request review endpoints -Changes for 0.16.0+## Changes for 0.16.0+ - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies@@ -26,7 +51,7 @@ - release endpoints - forkExistingRepo -Changes for 0.15.0+## Changes for 0.15.0  - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering@@ -48,7 +73,7 @@  See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) -Changes for 0.14.1+## Changes for 0.14.1  - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole`@@ -56,7 +81,7 @@   `RepoPublicity` - Don't require network access for search tests -Changes for 0.14.0+## Changes for 0.14.0  Large API changes: @@ -67,7 +92,7 @@ - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. -Changes for 0.5.0:+## Changes for 0.5.0:  * OAuth. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization.@@ -75,7 +100,7 @@ * Relax the attoparsec version requirements. * The above by [John Wiegley](https://github.com/jwiegley). -Changes for 0.4.1:+## Changes for 0.4.1:  * Stop using the uri package. * Use aeson version 0.6.1.0.@@ -83,11 +108,11 @@ * Use http-conduit over 1.8. * Use unordered-containers between 0.2 and 0.3. -Changes for 0.4.0:+## Changes for 0.4.0:  * Use http-conduit version 1.4.1.10. -Changes for 0.3.0:+## Changes for 0.3.0:  * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`.@@ -97,11 +122,11 @@   ever-changing `http-conduit` package. * Features by [Pavel Ryzhov](https://github.com/paulrzcz) and [Simon Hengel](https://github.com/sol). -Changes for 0.2.1:+## Changes for 0.2.1:  * Expand the unordered-containers dependency to anything in 0.1.x . -Changes for 0.2.0:+## Changes for 0.2.0:  * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names

@@ -1,5 +1,5 @@ name:                github-version:             0.18+version:             0.19 synopsis:            Access to the GitHub API, v3. description:   The GitHub API provides programmatic access to the full@@ -25,7 +25,7 @@ copyright:           Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category:            Network build-type:          Simple-tested-with:         GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1+tested-with:         GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 cabal-version:       >=1.10 extra-source-files:   README.md,@@ -74,10 +74,12 @@     GitHub.Data.Content     GitHub.Data.Definitions     GitHub.Data.DeployKeys+    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@@ -125,41 +127,46 @@     GitHub.Endpoints.Repos.Webhooks     GitHub.Endpoints.Search     GitHub.Endpoints.Users+    GitHub.Endpoints.Users.Emails     GitHub.Endpoints.Users.Followers     GitHub.Request -  -- Packages needed in order to build this package.-  build-depends: base                  >=4.7       && <4.11,-                 aeson                 >=0.7.0.6   && <1.3,-                 base-compat           >=0.9.1     && <0.10,-                 base16-bytestring     >=0.1.1.6   && <0.2,-                 binary                >=0.7.1.0   && <0.10,-                 binary-orphans        >=0.1.0.0   && <0.2,-                 byteable              >=0.1.1     && <0.2,-                 bytestring            >=0.10.4.0  && <0.11,-                 containers            >=0.5.5.1   && <0.6,-                 cryptohash            >=0.11      && <0.12,-                 deepseq               >=1.3.0.2   && <1.5,-                 deepseq-generics      >=0.1.1.2   && <0.3,-                 exceptions            >=0.8.0.2   && <0.9,-                 hashable              >=1.2.3.3   && <1.3,-                 http-client           >=0.4.8.1   && <0.6,-                 http-client-tls       >=0.2.2     && <0.4,-                 http-link-header      >=1.0.1     && <1.1,-                 http-types            >=0.8.6     && <0.11,-                 iso8601-time          >=0.1.4     && <0.2,-                 mtl                   >=2.1.3.1   && <2.3,-                 network-uri           >=2.6.0.3   && <2.7,-                 semigroups            >=0.16.2.2  && <0.19,-                 text                  >=1.2.0.6   && <1.3,-                 time                  >=1.4       && <1.9,-                 transformers          >=0.3.0.0   && <0.6,-                 transformers-compat   >=0.4.0.3   && <0.6,-                 unordered-containers  >=0.2       && <0.3,-                 vector                >=0.10.12.3 && <0.13,-                 vector-instances      >=3.3.0.1   && <3.5,+  -- Packages bundles with GHC, mtl and text are also here+  build-depends:+    base                  >=4.7       && <4.11,+    bytestring            >=0.10.4.0  && <0.11,+    containers            >=0.5.5.1   && <0.6,+    deepseq               >=1.3.0.2   && <1.5,+    mtl                   (>=2.1.3.1   && <2.2) || (>=2.2.1 && <2.3),+    text                  >=1.2.0.6   && <1.3,+    time                  >=1.4       && <1.10,+    transformers          >=0.3.0.0   && <0.6 -                 tls                   >=1.3.5+  -- other packages+  build-depends:+    aeson                 >=0.7.0.6   && <1.3,+    base-compat           >=0.9.1     && <0.10,+    base16-bytestring     >=0.1.1.6   && <0.2,+    binary                >=0.7.1.0   && <0.10,+    binary-orphans        >=0.1.0.0   && <0.2,+    byteable              >=0.1.1     && <0.2,+    cryptohash            >=0.11      && <0.12,+    deepseq-generics      >=0.1.1.2   && <0.3,+    exceptions            >=0.8.0.2   && <0.9,+    hashable              >=1.2.3.3   && <1.3,+    http-client           >=0.4.8.1   && <0.6,+    http-client-tls       >=0.2.2     && <0.4,+    http-link-header      >=1.0.1     && <1.1,+    http-types            >=0.12.1    && <0.13,+    iso8601-time          >=0.1.4     && <0.2,+    network-uri           >=2.6.0.3   && <2.7,+    semigroups            >=0.16.2.2  && <0.19,+    transformers-compat   >=0.4.0.3   && <0.6,+    unordered-containers  >=0.2       && <0.3,+    vector                >=0.10.12.3 && <0.13,+    vector-instances      >=3.3.0.1   && <3.5,++    tls                   >=1.3.5    if flag(aeson-compat)     build-depends: aeson-compat >=0.3.0.0 && <0.4

@@ -3,6 +3,7 @@ module GitHub.PullRequestsSpec where  import qualified GitHub+import GitHub.Data.Id (Id(Id))  import Prelude () import Prelude.Compat@@ -50,6 +51,13 @@              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")

@@ -158,9 +158,11 @@     -- ** Members     -- | See <https://developer.github.com/v3/orgs/members/>     ---    -- Missing endpoints: All except /Members List/+    -- Missing endpoints: All except /Members List/ and /Check Membership/     membersOfR,     membersOfWithR,+    isMemberOfR,+    orgInvitationsR,      -- ** Teams     -- | See <https://developer.github.com/v3/orgs/teams/>@@ -314,6 +316,17 @@     ownerInfoForR,     userInfoCurrentR, +    -- ** Emails+    -- | See <https://developer.github.com/v3/users/emails/>+    --+    -- Missing endpoints:+    --+    -- * Add email address(es)+    -- * Delete email address(es)+    -- * Toggle primary email visibility+    currentUserEmailsR,+    currentUserPublicEmailsR,+     -- ** Followers     -- | See <https://developer.github.com/v3/users/followers/>     --@@ -369,5 +382,6 @@ 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

@@ -37,9 +37,11 @@     module GitHub.Data.Content,     module GitHub.Data.Definitions,     module GitHub.Data.DeployKeys,+    module GitHub.Data.Email,     module GitHub.Data.Events,     module GitHub.Data.Gists,     module GitHub.Data.GitData,+    module GitHub.Data.Invitation,     module GitHub.Data.Issues,     module GitHub.Data.Milestone,     module GitHub.Data.Options,@@ -64,10 +66,12 @@ import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys+import GitHub.Data.Email import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id+import GitHub.Data.Invitation import GitHub.Data.Issues import GitHub.Data.Milestone import GitHub.Data.Name

@@ -18,7 +18,7 @@  import GitHub.Data.Id   (Id) import GitHub.Data.Name (Name)-import GitHub.Data.URL  (URL)+import GitHub.Data.URL  (URL (..))  -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them.@@ -254,5 +254,5 @@ instance FromJSON IssueLabel where     parseJSON = withObject "IssueLabel" $ \o -> IssueLabel         <$> o .: "color"-        <*> o .: "url"+        <*> o .:? "url" .!= URL "" -- in events there aren't URL         <*> o .: "name"

@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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"

@@ -0,0 +1,57 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+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

@@ -21,7 +21,7 @@     , issueEventsUrl   :: !URL     , issueHtmlUrl     :: !(Maybe URL)     , issueClosedBy    :: !(Maybe SimpleUser)-    , issueLabels      :: (Vector IssueLabel)+    , issueLabels      :: !(Vector IssueLabel)     , issueNumber      :: !Int     , issueAssignees   :: !(Vector SimpleUser)     , issueUser        :: !SimpleUser@@ -79,25 +79,35 @@ instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment +-- | See <https://developer.github.com/v3/issues/events/#events-1> data EventType-    = Mentioned        -- ^ The actor was @mentioned in an issue body.-    | Subscribed       -- ^ The actor subscribed to receive notifications for an issue.-    | Unsubscribed     -- ^ The issue was unsubscribed from by the actor.-    | Referenced       -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.-    | Merged           -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.-    | Assigned         -- ^ The issue was assigned to the actor.-    | Closed           -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.-    | Reopened         -- ^ The issue was reopened by the actor.-    | ActorUnassigned  -- ^ The issue was unassigned to the actor-    | Labeled          -- ^ A label was added to the issue.-    | Unlabeled        -- ^ A label was removed from the issue.-    | Milestoned       -- ^ The issue was added to a milestone.-    | Demilestoned     -- ^ The issue was removed from a milestone.-    | Renamed          -- ^ The issue title was changed.-    | Locked           -- ^ The issue was locked by the actor.-    | Unlocked         -- ^ The issue was unlocked by the actor.-    | HeadRefDeleted   -- ^ The pull request’s branch was deleted.-    | HeadRefRestored  -- ^ The pull request’s branch was restored.+    = Mentioned             -- ^ The actor was @mentioned in an issue body.+    | Subscribed            -- ^ The actor subscribed to receive notifications for an issue.+    | Unsubscribed          -- ^ The issue was unsubscribed from by the actor.+    | Referenced            -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.+    | Merged                -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.+    | Assigned              -- ^ The issue was assigned to the actor.+    | Closed                -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.+    | Reopened              -- ^ The issue was reopened by the actor.+    | ActorUnassigned       -- ^ The issue was unassigned to the actor+    | Labeled               -- ^ A label was added to the issue.+    | Unlabeled             -- ^ A label was removed from the issue.+    | Milestoned            -- ^ The issue was added to a milestone.+    | Demilestoned          -- ^ The issue was removed from a milestone.+    | Renamed               -- ^ The issue title was changed.+    | Locked                -- ^ The issue was locked by the actor.+    | Unlocked              -- ^ The issue was unlocked by the actor.+    | HeadRefDeleted        -- ^ The pull request’s branch was deleted.+    | HeadRefRestored       -- ^ The pull request’s branch was restored.+    | ReviewRequested       -- ^ The actor requested review from the subject on this pull request.+    | ReviewDismissed       -- ^ The actor dismissed a review from the pull request.+    | ReviewRequestRemoved  -- ^ The actor removed the review request for the subject on this pull request.+    | MarkedAsDuplicate     -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request.+    | UnmarkedAsDuplicate   -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate.+    | AddedToProject        -- ^ The issue was added to a project board.+    | MovedColumnsInProject -- ^ The issue was moved between columns in a project board.+    | RemovedFromProject    -- ^ The issue was removed from a project board.+    | ConvertedNoteToIssue  -- ^ The issue was created by converting a note in a project board to an issue.   deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)  instance NFData EventType where rnf = genericRnf@@ -112,11 +122,12 @@     , 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 Binary IssueEvent  instance FromJSON IssueEvent where     parseJSON = withObject "Event" $ \o -> IssueEvent@@ -127,27 +138,38 @@         <*> o .: "created_at"         <*> o .: "id"         <*> o .:? "issue"+        <*> o .:? "label"  instance FromJSON EventType where-    parseJSON (String "closed") = pure Closed-    parseJSON (String "reopened") = pure Reopened-    parseJSON (String "subscribed") = pure Subscribed-    parseJSON (String "merged") = pure Merged-    parseJSON (String "referenced") = pure Referenced-    parseJSON (String "mentioned") = pure Mentioned-    parseJSON (String "assigned") = pure Assigned-    parseJSON (String "unsubscribed") = pure Unsubscribed-    parseJSON (String "unassigned") = pure ActorUnassigned-    parseJSON (String "labeled") = pure Labeled-    parseJSON (String "unlabeled") = pure Unlabeled-    parseJSON (String "milestoned") = pure Milestoned-    parseJSON (String "demilestoned") = pure Demilestoned-    parseJSON (String "renamed") = pure Renamed-    parseJSON (String "locked") = pure Locked-    parseJSON (String "unlocked") = pure Unlocked-    parseJSON (String "head_ref_deleted") = pure HeadRefDeleted-    parseJSON (String "head_ref_restored") = pure HeadRefRestored-    parseJSON _ = fail "Could not build an EventType"+    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

@@ -96,6 +96,7 @@     | StateDirty     | StateUnstable     | StateBlocked+    | StateBehind   deriving     (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -105,6 +106,7 @@     toJSON StateDirty    = String "dirty"     toJSON StateUnstable = String "unstable"     toJSON StateBlocked  = String "blocked"+    toJSON StateBehind   = String "behind"  instance FromJSON MergeableState where     parseJSON (String "unknown")  = pure StateUnknown@@ -112,6 +114,7 @@     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

@@ -136,7 +136,7 @@     , pullRequestCommitRef   :: !Text     , pullRequestCommitSha   :: !Text     , pullRequestCommitUser  :: !SimpleUser-    , pullRequestCommitRepo  :: !Repo+    , pullRequestCommitRepo  :: !(Maybe Repo)     }   deriving (Show, Data, Typeable, Eq, Ord, Generic) 

@@ -14,6 +14,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id          (Id) import GitHub.Data.Name        (Name)+import GitHub.Data.Request     (IsPathPart (..)) import GitHub.Data.URL         (URL) import GitHub.Internal.Prelude import Prelude ()@@ -257,3 +258,13 @@         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"

@@ -36,6 +36,7 @@ import qualified Data.Text                 as T import qualified Network.HTTP.Types        as Types import qualified Network.HTTP.Types.Method as Method+import Network.URI                         (URI) ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------@@ -141,6 +142,7 @@     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@@ -158,7 +160,7 @@  statusOnlyOk :: StatusMap Bool statusOnlyOk =-    [ (202, True)+    [ (204, True)     , (404, False)     ] @@ -218,6 +220,8 @@             . showsPrec (appPrec + 1) m             . showString " "             . showsPrec (appPrec + 1) req+        RedirectQuery req -> showString "Redirect "+            . showsPrec (appPrec + 1) req       where         appPrec = 10 :: Int @@ -248,4 +252,7 @@     hashWithSalt salt (HeaderQuery h req) =         salt `hashWithSalt` (2 :: Int)              `hashWithSalt` h+             `hashWithSalt` req+    hashWithSalt salt (RedirectQuery req) =+        salt `hashWithSalt` (3 :: Int)              `hashWithSalt` req

@@ -10,6 +10,10 @@     membersOf',     membersOfR,     membersOfWithR,+    isMemberOf,+    isMemberOf',+    isMemberOfR,+    orgInvitationsR,     module GitHub.Data,     ) where @@ -54,3 +58,31 @@         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 <https://developer.github.com/v3/orgs/members/#check-membership>+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 <https://developer.github.com/v3/orgs/members/#list-pending-organization-invitations>+orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation)+orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] []

@@ -136,14 +136,14 @@  -- | Details on a specific repo, given the owner and repo name. ----- > userRepo "mike-burns" "github"+-- > repository "mike-burns" "github" repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing  -- | Details on a specific repo, given the owner and repo name. -- With authentication. ----- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github"+-- > repository' (Just (BasicAuth (user, password))) "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo =     executeRequestMaybe auth $ repositoryR user repo

@@ -13,6 +13,9 @@     readmeFor,     readmeFor',     readmeForR,+    archiveFor,+    archiveFor',+    archiveForR,      -- ** Create     createFile,@@ -34,7 +37,9 @@ 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 --@@ -78,6 +83,31 @@ readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo =     query ["repos", toPathPart user, toPathPart repo, "readme"] []++-- | The archive of a repo, given the repo owner, name, and archive type+--+-- > archiveFor "thoughtbot" "paperclip" ArchiveFormatTarball Nothing+archiveFor :: Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI)+archiveFor = archiveFor' Nothing++-- | The archive of a repo, given the repo owner, name, and archive type+-- With Authentication+--+-- > archiveFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" ArchiveFormatTarball Nothing+archiveFor' :: Maybe Auth ->  Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI)+archiveFor' auth user repo path ref =+    executeRequestMaybe auth $ archiveForR user repo path ref++archiveForR+    :: Name Owner+    -> Name Repo+    -> ArchiveFormat   -- ^ The type of archive to retrieve+    -> Maybe Text      -- ^ Git commit+    -> Request k URI+archiveForR user repo format ref =+    RedirectQuery $ Query path []+  where+    path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref  -- | Create a file. createFile

@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- The user emails API as described on+-- <http://developer.github.com/v3/users/emails/>.+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 <https://developer.github.com/v3/users/emails/#list-email-addresses-for-a-user>+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 <https://developer.github.com/v3/users/emails/#list-public-email-addresses-for-a-user>+currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email)+currentUserPublicEmailsR =+    pagedQuery ["user", "public_emails"] []

@@ -59,6 +59,7 @@ import Control.Monad.Error (MonadError (..)) #endif +import Control.Monad              (when) import Control.Monad.Catch        (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class  (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT)@@ -67,13 +68,13 @@  import Network.HTTP.Client        (HttpException (..), Manager, RequestBody (..), Response (..),-       applyBasicAuth, httpLbs, method, newManager, requestBody,-       requestHeaders, setQueryString)+       applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount,+       requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Client.TLS  (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types  (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types       (Method, RequestHeaders, Status (..))-import Network.URI              (URI)+import Network.URI              (URI, parseURIReference, relativeTo)  #if !MIN_VERSION_http_client(0,5,0) import qualified Control.Exception  as E@@ -82,6 +83,7 @@  import qualified Data.ByteString.Lazy         as LBS import qualified Data.Text                    as T+import qualified Data.Text.Encoding           as TE import qualified Data.Vector                  as V import qualified Network.HTTP.Client          as HTTP import qualified Network.HTTP.Client.Internal as HTTP@@ -125,6 +127,9 @@     performHttpReq httpReq (StatusQuery sm _)   = do         res <- httpLbs' httpReq         parseStatus sm  . responseStatus $ res+    performHttpReq httpReq (RedirectQuery _)   = do+        res <- httpLbs' httpReq+        parseRedirect (getUri httpReq) res      performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b     performHttpReq' httpReq Query {} = do@@ -172,6 +177,9 @@     performHttpReq httpReq (StatusQuery sm _)   = do         res <- httpLbs' httpReq         parseStatus sm  . responseStatus $ res+    performHttpReq httpReq (RedirectQuery _)   = do+        res <- httpLbs' httpReq+        parseRedirect (getUri httpReq) res      performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b     performHttpReq' httpReq Query {} = do@@ -222,6 +230,9 @@     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@@ -327,6 +338,24 @@     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. --