diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,18 @@ +## Changes for 0.26 + +- Generalize PagedQuery to allow its reuse by preview github APIs + [#439](https://github.com/phadej/github/pull/439) +- Add endpoint for listing organizations outside collaborators + [#445](https://github.com/phadej/github/pull/445) +- Add endpoint for users search + [#444](https://github.com/phadej/github/pull/444) +- Make repoWebhookResponseStatus optional + [#436](https://github.com/phadej/github/pull/436) +- Teams improvements + [#417](https://github.com/phadej/github/pull/417) +- Add deleteReference endpoint + [#388](https://github.com/phadej/github/pull/388) + ## Changes for 0.25 - Add `executeRequestWithMgrAndRes` diff --git a/github.cabal b/github.cabal --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.25 +version: 0.26 synopsis: Access to the GitHub API, v3. category: Network description: @@ -36,7 +36,8 @@ || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.1 + || ==8.8.3 + || ==8.10.1 extra-source-files: README.md @@ -132,6 +133,7 @@ GitHub.Endpoints.Issues.Milestones GitHub.Endpoints.Organizations GitHub.Endpoints.Organizations.Members + GitHub.Endpoints.Organizations.OutsideCollaborators GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Comments @@ -162,7 +164,7 @@ -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.14 + base >=4.7 && <4.15 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 @@ -174,15 +176,15 @@ -- other packages build-depends: - aeson >=1.4.0.0 && <1.5 - , base-compat >=0.10.4 && <0.12 + aeson >=1.4.0.0 && <1.6 + , base-compat >=0.11.1 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 - , http-client >=0.5.12 && <0.7 + , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.1 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -16,8 +16,9 @@ import GitHub (github) import GitHub.Data - (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR) + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), + SimpleUser (..), User, mkId) +import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -57,3 +58,10 @@ issues <- searchResultResults . fromRightS <$> github auth searchIssuesR query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 + + describe "searchUsers" $ + it "performs a user search via the API" $ withAuth $ \auth -> do + let query = "oleg.grenrus@iki.fi created:<2020-01-01" + users <- searchResultResults . fromRightS <$> github auth searchUsersR query + length users `shouldBe` 1 + simpleUserId (V.head users) `shouldBe` mkId (Proxy :: Proxy User) 51087 diff --git a/src/GitHub.hs b/src/GitHub.hs --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -100,6 +100,8 @@ referenceR, referencesR, createReferenceR, + deleteReferenceR, + namespacedReferencesR, -- ** Trees -- | See @@ -175,6 +177,11 @@ membersOfWithR, isMemberOfR, orgInvitationsR, + -- ** Outside Collaborators + -- | See + -- + -- Missing endpoints: All except /Outside Collaborator List/ + outsideCollaboratorsR, -- ** Teams -- | See @@ -355,13 +362,10 @@ -- * Search -- | See - -- - -- Missing endpoints: - -- - -- * Search users searchReposR, searchCodeR, searchIssuesR, + searchUsersR, -- * Users -- | See @@ -433,6 +437,7 @@ import GitHub.Endpoints.Issues.Milestones import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members +import GitHub.Endpoints.Organizations.OutsideCollaborators import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -156,7 +156,7 @@ data GitReference = GitReference { gitReferenceObject :: !GitObject , gitReferenceUrl :: !URL - , gitReferenceRef :: !Text + , gitReferenceRef :: !(Name GitReference) } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -154,7 +154,7 @@ -- /Note:/ 'Request' is not 'Functor' on purpose. data GenRequest (mt :: MediaType *) (rw :: RW) a where Query :: Paths -> QueryString -> GenRequest mt rw a - PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) + PagedQuery :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a -- | Command Command diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -50,7 +50,7 @@ , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. , simpleTeamSlug :: !(Name Team) , simpleTeamDescription :: !(Maybe Text) - , simpleTeamPrivacy :: !(Maybe Privacy) + , simpleTeamPrivacy :: !Privacy , simpleTeamPermission :: !Permission , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL @@ -66,7 +66,7 @@ , teamName :: !Text , teamSlug :: !(Name Team) , teamDescription :: !(Maybe Text) - , teamPrivacy :: !(Maybe Privacy) + , teamPrivacy :: !Privacy , teamPermission :: !Permission , teamMembersUrl :: !URL , teamRepositoriesUrl :: !URL @@ -83,8 +83,8 @@ { createTeamName :: !(Name Team) , createTeamDescription :: !(Maybe Text) , createTeamRepoNames :: !(Vector (Name Repo)) - -- , createTeamPrivacy :: Privacy - , createTeamPermission :: Permission + , createTeamPrivacy :: !Privacy + , createTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -94,8 +94,8 @@ data EditTeam = EditTeam { editTeamName :: !(Name Team) , editTeamDescription :: !(Maybe Text) - -- , editTeamPrivacy :: Privacy - , editTeamPermission :: !Permission + , editTeamPrivacy :: !(Maybe Privacy) + , editTeamPermission :: !(Maybe Permission) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -144,7 +144,7 @@ <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -156,7 +156,7 @@ <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -165,19 +165,29 @@ <*> o .: "organization" instance ToJSON CreateTeam where - toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - , "repo_names" .= repo_names - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (CreateTeam name desc repo_names privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "repo_names" .= repo_names + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON EditTeam where - toJSON (EditTeam name desc {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (EditTeam name desc privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance FromJSON TeamMembership where parseJSON = withObject "TeamMembership" $ \o -> TeamMembership diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -89,7 +89,7 @@ data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) - , repoWebhookResponseStatus :: !Text + , repoWebhookResponseStatus :: !(Maybe Text) , repoWebhookResponseMessage :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -254,8 +254,8 @@ instance FromJSON RepoWebhookResponse where parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse <$> o .: "code" - <*> o .: "status" - <*> o .: "message" + <*> o .:? "status" + <*> o .:? "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -10,6 +10,7 @@ referenceR, referencesR, createReferenceR, + deleteReferenceR, namespacedReferencesR, module GitHub.Data, ) where @@ -35,6 +36,12 @@ createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) + +-- | Delete a reference. +-- See +deleteReferenceR :: Name Owner -> Name Repo -> Name GitReference -> GenRequest 'MtUnit 'RW () +deleteReferenceR user repo ref = + Command Delete ["repos", toPathPart user, toPathPart repo , "git", "refs", toPathPart ref] mempty -- | Query namespaced references. -- See diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The organization members API as described on +-- . +module GitHub.Endpoints.Organizations.OutsideCollaborators ( + outsideCollaboratorsR, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | All the users who are outside collaborators of the specified organization. +-- +-- See +outsideCollaboratorsR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) +outsideCollaboratorsR organization = + pagedQuery ["orgs", toPathPart organization, "outside_collaborators"] [] diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -9,6 +9,7 @@ searchReposR, searchCodeR, searchIssuesR, + searchUsersR, module GitHub.Data, ) where @@ -35,3 +36,9 @@ searchIssuesR :: Text -> Request k (SearchResult Issue) searchIssuesR searchString = query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + +-- | Search users. +-- See +searchUsersR :: Text -> Request k (SearchResult SimpleUser) +searchUsersR searchString = + query ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -31,7 +31,7 @@ -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( - -- * A convinient execution of requests + -- * A convenient execution of requests github, github', GitHubRW, @@ -100,7 +100,6 @@ 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 @@ -121,10 +120,10 @@ import Paths_github (version) ------------------------------------------------------------------------------- --- Convinience +-- Convenience ------------------------------------------------------------------------------- --- | A convinience function to turn functions returning @'Request' rw x@, +-- | A convenience function to turn functions returning @'Request' rw x@, -- into functions returning @IO (Either 'Error' x)@. -- -- >>> :t \auth -> github auth userInfoForR @@ -242,7 +241,7 @@ performHttpReq httpReq (PagedQuery _ _ l) = unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) where - predicate v = lessFetchCount (V.length v) l + predicate v = lessFetchCount (length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq