github-0.14.1/fixtures/0000755000000000000000000000000012647713071013126 5ustar0000000000000000github-0.14.1/spec/0000755000000000000000000000000012650115011012167 5ustar0000000000000000github-0.14.1/spec/GitHub/0000755000000000000000000000000012654115311013360 5ustar0000000000000000github-0.14.1/src/0000755000000000000000000000000012654115311012033 5ustar0000000000000000github-0.14.1/src/GitHub/0000755000000000000000000000000012654115311013215 5ustar0000000000000000github-0.14.1/src/GitHub/Data/0000755000000000000000000000000012654115311014066 5ustar0000000000000000github-0.14.1/src/GitHub/Data/Webhooks/0000755000000000000000000000000012650115011015640 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/0000755000000000000000000000000012650124206015157 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/Activity/0000755000000000000000000000000012650115011016745 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/Gists/0000755000000000000000000000000012650115011016242 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/GitData/0000755000000000000000000000000012650115011016466 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/Issues/0000755000000000000000000000000012650115011016424 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/Organizations/0000755000000000000000000000000012654115311020007 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/PullRequests/0000755000000000000000000000000012650115011017621 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/Repos/0000755000000000000000000000000012650115011016241 5ustar0000000000000000github-0.14.1/src/GitHub/Endpoints/Users/0000755000000000000000000000000012650115011016252 5ustar0000000000000000github-0.14.1/src/GitHub.hs0000644000000000000000000002014012654115311013546 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 -- ** Starring -- | See -- -- Missing endpoints: -- -- * Check if you are starring a repository -- * Star a repository -- * Unstar a repository stargazersForR, reposStarredByR, myStarredR, -- ** 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 -- * Star a gist -- * Unstar a gist -- * Check if a gist is starred -- * Fork a gist -- * List gist forks -- * Delete a gist gistsR, gistR, -- ** 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 -- -- Missing endpoints: -- -- * List issues issueR, issuesForRepoR, createIssueR, editIssueR, -- ** Comments -- | See -- -- Missing endpoints: -- -- * Delete comment commentR, commentsR, createCommentR, 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/ membersOfR, membersOfWithR, -- ** Teams -- | See -- -- Missing endpoints: -- -- * Query team member (deprecated) -- * Add team member (deprecated) -- * Remove team member (deprecated) -- * List team repos -- * Check if a team manages a repository -- * Add team repository -- * Remove team repository teamsOfR, teamInfoForR, createTeamForR, editTeamR, deleteTeamR, listTeamMembersR, 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 pullRequestReviewCommentsR, pullRequestReviewCommentR, -- * 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, -- ** Forks -- | See -- -- Missing endpoints: -- -- * Create a fork forksForR, -- ** Webhooks -- | See webhooksForR, webhookForR, createRepoWebhookR, editRepoWebhookR, testPushRepoWebhookR, pingRepoWebhookR, deleteRepoWebhookR, -- * Search -- | See -- -- Missing endpoints: -- -- * Search users searchReposR, searchCodeR, searchIssuesR, -- * Users -- | See -- -- Missing endpoints: -- -- * Update the authenticated user -- * Query all users userInfoForR, ownerInfoForR, userInfoCurrentR, -- ** 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, -- * Data definitions module GitHub.Data, -- * Request handling module GitHub.Request, ) where import GitHub.Data 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.ReviewComments import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users import GitHub.Endpoints.Users.Followers import GitHub.Request github-0.14.1/src/GitHub/Auth.hs0000644000000000000000000000165612654115311014462 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Auth where import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Binary (Binary) import Data.Data (Data, Typeable) import GHC.Generics (Generic) 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 String -- custom API endpoint without -- trailing slash Token -- token deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Auth where rnf = genericRnf instance Binary Auth github-0.14.1/src/GitHub/Data.hs0000644000000000000000000000417012650115011014415 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- 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, mkTeamName, mkOrganizationName, mkRepoName, fromUserName, fromOrganizationName, -- ** Id Id, mkId, untagId, mkOwnerId, mkTeamId, mkOrganizationId, mkRepoId, -- * Module re-exports module GitHub.Auth, module GitHub.Data.Comments, module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, module GitHub.Data.PullRequests, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Search, module GitHub.Data.Teams, module GitHub.Data.Webhooks, ) where import Prelude () import Prelude.Compat import Data.Text (Text) import GitHub.Auth import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Issues import GitHub.Data.Name import GitHub.Data.PullRequests import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.Webhooks mkOwnerId :: Int -> Id Owner mkOwnerId = Id mkOwnerName :: Text -> Name Owner mkOwnerName = 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 fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName fromUserName :: Name User -> Name Owner fromUserName = N . untagName github-0.14.1/src/GitHub/Data/Comments.hs0000644000000000000000000000441712650115011016206 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Comments where import Prelude () import Prelude.Compat import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.=)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) import GitHub.Data.Definitions import GitHub.Data.Id data Comment = Comment { commentPosition :: !(Maybe Int) ,commentLine :: !(Maybe Int) ,commentBody :: !Text ,commentCommitId :: !(Maybe Text) ,commentUpdatedAt :: !UTCTime ,commentHtmlUrl :: !(Maybe Text) ,commentUrl :: !Text ,commentCreatedAt :: !(Maybe UTCTime) ,commentPath :: !(Maybe Text) ,commentUser :: !SimpleUser ,commentId :: !(Id Comment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment where rnf = genericRnf instance 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.14.1/src/GitHub/Data/Content.hs0000644000000000000000000000642412650115011016033 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Content where import Prelude () import Prelude.Compat import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), Value (..), withObject, withText, (.:)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) import qualified Data.Text as T 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 :: !Text ,contentGitUrl :: !Text ,contentHtmlUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo 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: " ++ T.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" github-0.14.1/src/GitHub/Data/Definitions.hs0000644000000000000000000002001212654115311016670 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Definitions where import Prelude () import Prelude.Compat import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Control.Monad (mfilter) import Data.Aeson.Compat (FromJSON (..), Object, withObject, withText, (.:), (.:?)) import Data.Aeson.Types (Parser) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) import Network.HTTP.Client (HttpException) import qualified Control.Exception as E import qualified Data.Text as T import GitHub.Data.Id import GitHub.Data.Name -- | 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 :: !Text , simpleUserUrl :: !Text , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' } 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 :: !Text , simpleOrganizationAvatarUrl :: !Text } 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 :: !Text , simpleOwnerAvatarUrl :: !Text , 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 :: !Text , 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 :: !Text , userHtmlUrl :: !Text } 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 :: !Text , organizationPublicGists :: !Int , organizationHtmlUrl :: !Text , organizationEmail :: !(Maybe Text) , organizationFollowing :: !Int , organizationPublicRepos :: !Int , organizationUrl :: !Text , 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" <*> obj .: "type" 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) github-0.14.1/src/GitHub/Data/Gists.hs0000644000000000000000000000610112654115311015511 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Gists where import Prelude () import Prelude.Compat import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Language) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), withObject, (.:), (.:?)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.HashMap.Strict (HashMap) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) data Gist = Gist { gistUser :: !SimpleUser ,gistGitPushUrl :: !Text ,gistUrl :: !Text ,gistDescription :: !(Maybe Text) ,gistCreatedAt :: !UTCTime ,gistPublic :: !Bool ,gistComments :: !Int ,gistUpdatedAt :: !UTCTime ,gistHtmlUrl :: !Text ,gistId :: !(Name Gist) ,gistFiles :: !(HashMap Text GistFile) ,gistGitPullUrl :: !Text } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf instance Binary Gist instance FromJSON Gist where parseJSON = withObject "Gist" $ \o -> Gist <$> o .: "owner" <*> o .: "git_push_url" <*> o .: "url" <*> o .:? "description" <*> o .: "created_at" <*> o .: "public" <*> o .: "comments" <*> o .: "updated_at" <*> o .: "html_url" <*> o .: "id" <*> o .: "files" <*> o .: "git_push_url" data GistFile = GistFile { gistFileType :: !Text ,gistFileRawUrl :: !Text ,gistFileSize :: !Int ,gistFileLanguage :: !(Maybe Language) ,gistFileFilename :: !Text ,gistFileContent :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Generic) instance NFData GistFile where rnf = genericRnf instance Binary GistFile instance FromJSON GistFile where parseJSON = withObject "GistFile" $ \o -> GistFile <$> o .: "type" <*> o .: "raw_url" <*> o .: "size" <*> o .:? "language" <*> o .: "filename" <*> o .:? "content" data GistComment = GistComment { gistCommentUser :: !SimpleUser ,gistCommentUrl :: !Text ,gistCommentCreatedAt :: !UTCTime ,gistCommentBody :: !Text ,gistCommentUpdatedAt :: !UTCTime ,gistCommentId :: !(Id GistComment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment where rnf = genericRnf 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.14.1/src/GitHub/Data/GitData.hs0000644000000000000000000002137212650115011015735 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.GitData where import Prelude () import Prelude.Compat import GitHub.Data.Definitions import GitHub.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) import 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 :: !Text ,commitGitCommit :: !GitCommit ,commitCommitter :: !(Maybe SimpleUser) ,commitAuthor :: !(Maybe SimpleUser) ,commitFiles :: !(Vector File) ,commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit where rnf = genericRnf instance Binary Commit data Tree = Tree { treeSha :: !(Name Tree) ,treeUrl :: !Text ,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 Text) ,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 :: !Text ,gitCommitCommitter :: !GitUser ,gitCommitAuthor :: !GitUser ,gitCommitTree :: !Tree ,gitCommitSha :: !(Maybe (Name GitCommit)) ,gitCommitParents :: !(Vector Tree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit data Blob = Blob { blobUrl :: !Text ,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 :: !Text ,tagTarballUrl :: !Text ,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 :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf instance Binary BranchCommit data Diff = Diff { diffStatus :: !Text ,diffBehindBy :: !Int ,diffPatchUrl :: !Text ,diffUrl :: !Text ,diffBaseCommit :: !Commit ,diffCommits :: !(Vector Commit) ,diffTotalCommits :: !Int ,diffHtmlUrl :: !Text ,diffFiles :: !(Vector File) ,diffAheadBy :: !Int ,diffDiffUrl :: !Text ,diffPermalinkUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf 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 :: !Text ,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 :: !Text } 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 :: !Text ,fileStatus :: !Text ,fileRawUrl :: !Text ,fileAdditions :: !Int ,fileSha :: !Text ,fileChanges :: !Int ,filePatch :: !(Maybe Text) ,fileFilename :: !Text ,fileDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData File where rnf = genericRnf 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.14.1/src/GitHub/Data/Id.hs0000644000000000000000000000204112650115011014744 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Id ( Id(..), mkId, untagId, ) where import Control.DeepSeq (NFData (..)) import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Hashable (Hashable) import GHC.Generics (Generic) -- | 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.14.1/src/GitHub/Data/Issues.hs0000644000000000000000000002350112650115011015667 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Issues where import Prelude () import Prelude.Compat import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.PullRequests import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) data Issue = Issue { issueClosedAt :: Maybe UTCTime ,issueUpdatedAt :: UTCTime ,issueEventsUrl :: Text ,issueHtmlUrl :: Maybe Text ,issueClosedBy :: Maybe SimpleUser ,issueLabels :: (Vector IssueLabel) ,issueNumber :: Int ,issueAssignee :: Maybe SimpleUser ,issueUser :: SimpleUser ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference ,issueUrl :: Text ,issueCreatedAt :: UTCTime ,issueBody :: Maybe Text ,issueState :: Text ,issueId :: Id Issue ,issueComments :: Int ,issueMilestone :: Maybe Milestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: Text , newIssueBody :: Maybe Text , newIssueAssignee :: Maybe Text , newIssueMilestone :: Maybe Int , newIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: Maybe Text , editIssueBody :: Maybe Text , editIssueAssignee :: Maybe Text , editIssueState :: Maybe Text , editIssueMilestone :: Maybe Int , editIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue data Milestone = Milestone { milestoneCreator :: SimpleUser ,milestoneDueOn :: Maybe UTCTime ,milestoneOpenIssues :: Int ,milestoneNumber :: Int ,milestoneClosedIssues :: Int ,milestoneDescription :: Maybe Text ,milestoneTitle :: Text ,milestoneUrl :: Text ,milestoneCreatedAt :: UTCTime ,milestoneState :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Milestone where rnf = genericRnf instance Binary Milestone data IssueLabel = IssueLabel { labelColor :: Text ,labelUrl :: Text ,labelName :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueLabel where rnf = genericRnf instance Binary IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime ,issueCommentUser :: SimpleUser ,issueCommentUrl :: Text ,issueCommentHtmlUrl :: Text ,issueCommentCreatedAt :: UTCTime ,issueCommentBody :: Text ,issueCommentId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. | Subscribed -- ^ The actor subscribed to receive notifications for an issue. | Unsubscribed -- ^ The issue was unsubscribed from by the actor. | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. | Assigned -- ^ The issue was assigned to the actor. | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. | Reopened -- ^ The issue was reopened by the actor. | ActorUnassigned -- ^ The issue was unassigned to the actor | Labeled -- ^ A label was added to the issue. | Unlabeled -- ^ A label was removed from the issue. | Milestoned -- ^ The issue was added to a milestone. | Demilestoned -- ^ The issue was removed from a milestone. | Renamed -- ^ The issue title was changed. | Locked -- ^ The issue was locked by the actor. | Unlocked -- ^ The issue was unlocked by the actor. | HeadRefDeleted -- ^ The pull request’s branch was deleted. | HeadRefRestored -- ^ The pull request’s branch was restored. deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event data Event = Event { eventActor :: !SimpleUser ,eventType :: !EventType ,eventCommitId :: !(Maybe Text) ,eventUrl :: !Text ,eventCreatedAt :: !UTCTime ,eventId :: !Int ,eventIssue :: !(Maybe Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf instance Binary Event -- | A data structure for describing how to filter issues. This is used by -- @issuesForRepo@. data IssueLimitation = AnyMilestone -- ^ Issues appearing in any milestone. [default] | NoMilestone -- ^ Issues without a milestone. | MilestoneId Int -- ^ Only issues that are in the milestone with the given id. | Open -- ^ Only open issues. [default] | OnlyClosed -- ^ Only closed issues. | Unassigned -- ^ Issues to which no one has been assigned ownership. | AnyAssignment -- ^ All issues regardless of assignment. [default] | AssignedTo String -- ^ Only issues assigned to the user with the given login. | Mentions String -- ^ Issues which mention the given string, taken to be a user's login. | Labels [String] -- ^ A list of labels to filter by. | Ascending -- ^ Sort ascending. | Descending -- ^ Sort descending. [default] | Since UTCTime -- ^ Only issues created since the specified date and time. | PerPage Int -- ^ Download this many issues per query deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData IssueLimitation where rnf = genericRnf instance Binary IssueLimitation -- JSON instances instance FromJSON Event where parseJSON = withObject "Event" $ \o -> Event <$> o .: "actor" <*> o .: "event" <*> o .:? "commit_id" <*> o .: "url" <*> o .: "created_at" <*> o .: "id" <*> o .:? "issue" instance FromJSON EventType where parseJSON (String "closed") = pure Closed parseJSON (String "reopened") = pure Reopened parseJSON (String "subscribed") = pure Subscribed parseJSON (String "merged") = pure Merged parseJSON (String "referenced") = pure Referenced parseJSON (String "mentioned") = pure Mentioned parseJSON (String "assigned") = pure Assigned parseJSON (String "unsubscribed") = pure Unsubscribed parseJSON (String "unassigned") = pure ActorUnassigned parseJSON (String "labeled") = pure Labeled parseJSON (String "unlabeled") = pure Unlabeled parseJSON (String "milestoned") = pure Milestoned parseJSON (String "demilestoned") = pure Demilestoned parseJSON (String "renamed") = pure Renamed parseJSON (String "locked") = pure Locked parseJSON (String "unlocked") = pure Unlocked parseJSON (String "head_ref_deleted") = pure HeadRefDeleted parseJSON (String "head_ref_restored") = pure HeadRefRestored parseJSON _ = fail "Could not build an EventType" instance FromJSON IssueLabel where parseJSON = withObject "IssueLabel" $ \o -> IssueLabel <$> o .: "color" <*> o .: "url" <*> o .: "name" 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 .:? "assignee" <*> o .: "user" <*> o .: "title" <*> o .:? "pull_request" <*> o .: "url" <*> o .: "created_at" <*> o .: "body" <*> o .: "state" <*> o .: "id" <*> o .: "comments" <*> o .:? "milestone" instance ToJSON NewIssue where toJSON (NewIssue t b a m ls) = object [ "title" .= t , "body" .= b , "assignee" .= a , "milestone" .= m , "labels" .= ls ] instance ToJSON EditIssue where toJSON (EditIssue t b a s m ls) = object $ filter notNull $ [ "title" .= t , "body" .= b , "assignee" .= a , "state" .= s , "milestone" .= m , "labels" .= ls ] where notNull (_, Null) = False notNull (_, _) = True instance FromJSON Milestone where parseJSON = withObject "Milestone" $ \o -> Milestone <$> o .: "creator" <*> o .: "due_on" <*> o .: "open_issues" <*> o .: "number" <*> o .: "closed_issues" <*> o .: "description" <*> o .: "title" <*> o .: "url" <*> o .: "created_at" <*> o .: "state" github-0.14.1/src/GitHub/Data/Name.hs0000644000000000000000000000231112650115011015270 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Name ( Name(..), mkName, untagName, ) where import Control.DeepSeq (NFData (..)) import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Hashable (Hashable) import Data.String (IsString (..)) import Data.Text (Text) import GHC.Generics (Generic) 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 github-0.14.1/src/GitHub/Data/PullRequests.hs0000644000000000000000000002352312650115011017070 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.PullRequests where import Prelude () import Prelude.Compat import GitHub.Data.Definitions import GitHub.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.:?), (.=)) import Data.Aeson.Types (Object, Parser) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) ,simplePullRequestCreatedAt :: !UTCTime ,simplePullRequestUser :: !SimpleUser ,simplePullRequestPatchUrl :: !Text ,simplePullRequestState :: !Text ,simplePullRequestNumber :: !Int ,simplePullRequestHtmlUrl :: !Text ,simplePullRequestUpdatedAt :: !UTCTime ,simplePullRequestBody :: !Text ,simplePullRequestIssueUrl :: !Text ,simplePullRequestDiffUrl :: !Text ,simplePullRequestUrl :: !Text ,simplePullRequestLinks :: !PullRequestLinks ,simplePullRequestMergedAt :: !(Maybe UTCTime) ,simplePullRequestTitle :: !Text ,simplePullRequestId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest data PullRequest = PullRequest { -- this is a duplication of a PullRequest pullRequestClosedAt :: !(Maybe UTCTime) ,pullRequestCreatedAt :: !UTCTime ,pullRequestUser :: !SimpleUser ,pullRequestPatchUrl :: !Text ,pullRequestState :: !Text ,pullRequestNumber :: !Int ,pullRequestHtmlUrl :: !Text ,pullRequestUpdatedAt :: !UTCTime ,pullRequestBody :: !Text ,pullRequestIssueUrl :: !Text ,pullRequestDiffUrl :: !Text ,pullRequestUrl :: !Text ,pullRequestLinks :: !PullRequestLinks ,pullRequestMergedAt :: !(Maybe UTCTime) ,pullRequestTitle :: !Text ,pullRequestId :: !Int ,pullRequestMergedBy :: !(Maybe SimpleUser) ,pullRequestChangedFiles :: !Int ,pullRequestHead :: !PullRequestCommit ,pullRequestComments :: !Int ,pullRequestDeletions :: !Int ,pullRequestAdditions :: !Int ,pullRequestReviewComments :: !Int ,pullRequestBase :: !PullRequestCommit ,pullRequestCommits :: !Int ,pullRequestMerged :: !Bool ,pullRequestMergeable :: !(Maybe Bool) } 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 EditPullRequestState) } 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 :: !Text ,pullRequestLinksComments :: !Text ,pullRequestLinksHtml :: !Text ,pullRequestLinksSelf :: !Text } 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 :: !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 deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf instance Binary PullRequestEventType data PullRequestReference = PullRequestReference { pullRequestReferenceHtmlUrl :: !(Maybe Text) ,pullRequestReferencePatchUrl :: !(Maybe Text) ,pullRequestReferenceDiffUrl :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestReference where rnf = genericRnf instance Binary PullRequestReference data EditPullRequestState = EditPullRequestStateOpen | EditPullRequestStateClosed deriving (Show, Generic) instance NFData EditPullRequestState where rnf = genericRnf instance Binary EditPullRequestState -- 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 .: "issue_url" <*> o .: "diff_url" <*> o .: "url" <*> o .: "_links" <*> o .:? "merged_at" <*> o .: "title" <*> o .: "id" instance ToJSON EditPullRequestState where toJSON (EditPullRequestStateOpen) = String "open" toJSON (EditPullRequestStateClosed) = String "closed" instance ToJSON EditPullRequest where toJSON (EditPullRequest t b s) = object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] 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 .: "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" instance FromJSON PullRequestLinks where parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks <$> o <.:> ["review_comments", "href"] <*> o <.:> ["comments", "href"] <*> o <.:> ["html", "href"] <*> o <.:> ["self", "href"] 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 _ = fail "Could not build a PullRequestEventType" instance FromJSON PullRequestReference where parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference <$> o .:? "html_url" <*> o .:? "patch_url" <*> o .:? "diff_url" -- Helpers -- | Produce the value for the last key by traversing. (<.:>) :: FromJSON v => Object -> [Text] -> Parser v obj <.:> [key] = obj .: key obj <.:> (key:keys) = do obj' <- obj .: key obj' <.:> keys _obj <.:> [] = fail "<.:> never happens - empty path" github-0.14.1/src/GitHub/Data/Repos.hs0000644000000000000000000002235612654115311015522 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ -- orphan-ish instance. module GitHub.Data.Repos where import Prelude () import Prelude.Compat import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) --import Control.Arrow (first) -- Data.Bifunctor would be better import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Hashable (Hashable (..)) import Data.String (IsString (..)) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) import qualified Data.HashMap.Strict as HM #if UNSAFE import Unsafe.Coerce (unsafeCoerce) #endif data Repo = Repo { repoSshUrl :: !(Maybe Text) ,repoDescription :: !(Maybe Text) ,repoCreatedAt :: !(Maybe UTCTime) ,repoHtmlUrl :: !Text ,repoSvnUrl :: !(Maybe Text) ,repoForks :: !(Maybe Int) ,repoHomepage :: !(Maybe Text) ,repoFork :: !(Maybe Bool) ,repoGitUrl :: !(Maybe Text) ,repoPrivate :: !Bool ,repoCloneUrl :: !(Maybe Text) ,repoSize :: !(Maybe Int) ,repoUpdatedAt :: !(Maybe UTCTime) ,repoWatchers :: !(Maybe Int) ,repoOwner :: !SimpleOwner ,repoName :: !(Name Repo) ,repoLanguage :: !(Maybe Language) ,repoMasterBranch :: !(Maybe Text) ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) ,repoUrl :: !Text ,repoOpenIssues :: !(Maybe Int) ,repoHasWiki :: !(Maybe Bool) ,repoHasIssues :: !(Maybe Bool) ,repoHasDownloads :: !(Maybe Bool) ,repoParent :: !(Maybe RepoRef) ,repoSource :: !(Maybe RepoRef) ,repoHooksUrl :: !Text ,repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance 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 !Text !(Name User) !Text !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor where rnf = genericRnf instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url OwnerUser -- JSON instances instance FromJSON Repo where parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" <*> o .: "description" <*> o .:? "created_at" <*> o .: "html_url" <*> o .:? "svn_url" <*> o .:? "forks" <*> o .:? "homepage" <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" <*> o .:? "watchers" <*> o .: "owner" <*> o .: "name" <*> o .:? "language" <*> o .:? "master_branch" <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" <*> o .:? "open_issues" <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" <*> o .:? "parent" <*> o .:? "source" <*> o .: "hooks_url" <*> o .: "stargazers_count" 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 of _ | t == ("Anonymous" :: Text) -> AnonymousContributor <$> o .: "contributions" <*> o .: "name" _ | otherwise -> KnownContributor <$> o .: "contributions" <*> o .: "avatar_url" <*> o .: "login" <*> o .: "url" <*> o .: "id" <*> o .: "gravatar_id" instance FromJSON Language where parseJSON = withText "Language" (pure . Language) instance ToJSON Language where toJSON = toJSON . getLanguage instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a #ifdef UNSAFE mapKeyLanguage = unsafeCoerce #else mapKeyLanguage = mapKey Language mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a mapKey f = HM.fromList . map (first f) . HM.toList #endif github-0.14.1/src/GitHub/Data/Request.hs0000644000000000000000000001357212650115011016053 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Request ( Request(..), CommandMethod(..), toMethod, StatusMap(..), MergeResult(..), Paths, IsPathPart(..), QueryString, Count, ) where import Data.Aeson.Compat (FromJSON) import Data.Hashable (Hashable (..)) import Data.Typeable (Typeable) import Data.Vector (Vector) import GHC.Generics (Generic) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ type Paths = [String] type QueryString = [(BS.ByteString, Maybe BS.ByteString)] type Count = Int class IsPathPart a where toPathPart :: a -> String instance IsPathPart (Name a) where toPathPart = T.unpack . untagName instance IsPathPart (Id a) where toPathPart = show . untagId -- | Http method of requests with body. data CommandMethod a where Post :: CommandMethod a Patch :: CommandMethod a Put :: CommandMethod a Delete :: CommandMethod () deriving (Typeable) deriving instance Eq (CommandMethod a) instance Show (CommandMethod a) where showsPrec _ Post = showString "Post" showsPrec _ Patch = showString "Patch" showsPrec _ Put = showString "Put" showsPrec _ Delete = showString "Delete" instance Hashable (CommandMethod a) where hashWithSalt salt Post = hashWithSalt salt (0 :: Int) hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) hashWithSalt salt Put = hashWithSalt salt (2 :: Int) hashWithSalt salt Delete = hashWithSalt salt (3 :: Int) toMethod :: CommandMethod a -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut toMethod Delete = Method.methodDelete -- | Result of merge operation data MergeResult = MergeSuccessful | MergeCannotPerform | MergeConflict deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) instance Hashable MergeResult -- | Status code transform data StatusMap a where StatusOnlyOk :: StatusMap Bool StatusMerge :: StatusMap MergeResult deriving (Typeable) deriving instance Eq (StatusMap a) instance Show (StatusMap a) where showsPrec _ StatusOnlyOk = showString "StatusOnlyOK" showsPrec _ StatusMerge = showString "StatusMerge" instance Hashable (StatusMap a) where hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int) ------------------------------------------------------------------------------ -- Github request ------------------------------------------------------------------------------ -- | Github request data type. -- -- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. data Request (k :: Bool) a where Query :: FromJSON a => Paths -> QueryString -> Request k a PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a) Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a StatusQuery :: StatusMap a -> Request k () -> Request k a deriving (Typeable) deriving instance Eq (Request k a) instance Show (Request k a) where showsPrec d r = case r of Query ps qs -> showParen (d > appPrec) $ showString "Query " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs PagedQuery ps qs l -> showParen (d > appPrec) $ showString "PagedQuery " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs . showString " " . showsPrec (appPrec + 1) l Command m ps body -> showParen (d > appPrec) $ showString "Command " . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) body StatusQuery m req -> showParen (d > appPrec) $ showString "Status " . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) req where appPrec = 10 :: Int instance Hashable (Request 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 hashWithSalt salt (StatusQuery sm req) = salt `hashWithSalt` (3 :: Int) `hashWithSalt` sm `hashWithSalt` req github-0.14.1/src/GitHub/Data/Search.hs0000644000000000000000000000353212650115011015623 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Search where import Prelude () import Prelude.Compat import GitHub.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), withObject, (.!=), (.:), (.:?)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) import 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 :: !Text ,codeGitUrl :: !Text ,codeHtmlUrl :: !Text ,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.14.1/src/GitHub/Data/Teams.hs0000644000000000000000000001732512654115311015503 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Teams where import Prelude () import Prelude.Compat import GitHub.Data.Definitions import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.!=), (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) 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 SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) ,simpleTeamUrl :: !Text ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. ,simpleTeamSlug :: !(Name Team) ,simpleTeamDescription :: !(Maybe Text) ,simpleTeamPrivacy :: !(Maybe Privacy) ,simpleTeamPermission :: !Permission ,simpleTeamMembersUrl :: !Text ,simpleTeamRepositoriesUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) ,teamUrl :: !Text ,teamName :: !(Name Team) ,teamSlug :: !Text ,teamDescription :: !(Maybe Text) ,teamPrivacy :: !(Maybe Privacy) ,teamPermission :: !Permission ,teamMembersUrl :: !Text ,teamRepositoriesUrl :: !Text ,teamMembersCount :: !Int ,teamReposCount :: !Int ,teamOrganization :: !SimpleOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf 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 :: !Text, 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 Role where parseJSON (String attr) = case attr of "maintainer" -> return RoleMaintainer "member" -> return RoleMember _ -> fail "Unknown Role" parseJSON _ = fail "Could not build Role" instance ToJSON Role where toJSON RoleMaintainer = String "maintainer" toJSON RoleMember = String "member" instance ToJSON Permission where toJSON attr = String $ case attr of PermissionPull -> "pull" PermissionPush -> "push" PermissionAdmin -> "admin" instance FromJSON Permission where parseJSON (String attr) = case attr of "pull" -> return PermissionPull "push" -> return PermissionPush "admin" -> return PermissionAdmin _ -> fail "Unknown Permission Attribute" parseJSON _ = fail "Could not build Permission" instance FromJSON Privacy where parseJSON (String attr) = case attr of "secret" -> return PrivacySecret "closed" -> return PrivacyClosed _ -> fail "Unknown Privacy Attribute" parseJSON _ = fail "Could not build Privacy" instance ToJSON Privacy where toJSON attr = String $ case attr of PrivacySecret -> "secret" PrivacyClosed -> "closed" instance FromJSON ReqState where parseJSON (String attr) = case attr of "active" -> return StateActive "pending" -> return StatePending _ -> fail "Unknown ReqState" parseJSON _ = fail "Could not build ReqState" 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.14.1/src/GitHub/Data/Webhooks.hs0000644000000000000000000001732312650115011016202 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Webhooks where import Prelude () import Prelude.Compat import GitHub.Data.Id (Id) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.=)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) import qualified Data.Map as M data RepoWebhook = RepoWebhook { repoWebhookUrl :: !Text ,repoWebhookTestUrl :: !Text ,repoWebhookId :: !(Id RepoWebhook) ,repoWebhookName :: !Text ,repoWebhookActive :: !Bool ,repoWebhookEvents :: !(Vector RepoWebhookEvent) ,repoWebhookConfig :: !(M.Map Text Text) ,repoWebhookLastResponse :: !RepoWebhookResponse ,repoWebhookUpdatedAt :: !UTCTime ,repoWebhookCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook where rnf = genericRnf instance Binary RepoWebhook data RepoWebhookEvent = WebhookWildcardEvent | WebhookCommitCommentEvent | WebhookCreateEvent | WebhookDeleteEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent | WebhookForkEvent | WebhookGollumEvent | WebhookIssueCommentEvent | WebhookIssuesEvent | WebhookMemberEvent | WebhookPageBuildEvent | WebhookPublicEvent | WebhookPullRequestReviewCommentEvent | WebhookPullRequestEvent | WebhookPushEvent | WebhookReleaseEvent | WebhookStatusEvent | WebhookTeamAddEvent | WebhookWatchEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf 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 "issue_comment") = pure WebhookIssueCommentEvent parseJSON (String "issues") = pure WebhookIssuesEvent parseJSON (String "member") = pure WebhookMemberEvent parseJSON (String "page_build") = pure WebhookPageBuildEvent parseJSON (String "public") = pure WebhookPublicEvent parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "pull_request") = pure WebhookPullRequestEvent parseJSON (String "push") = pure WebhookPushEvent parseJSON (String "release") = pure WebhookReleaseEvent parseJSON (String "status") = pure WebhookStatusEvent parseJSON (String "team_add") = pure WebhookTeamAddEvent parseJSON (String "watch") = pure WebhookWatchEvent parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where toJSON (WebhookWildcardEvent) = String "*" toJSON (WebhookCommitCommentEvent) = String "commit_comment" toJSON (WebhookCreateEvent) = String "create" toJSON (WebhookDeleteEvent) = String "delete" toJSON (WebhookDeploymentEvent) = String "deployment" toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" toJSON (WebhookForkEvent) = String "fork" toJSON (WebhookGollumEvent) = String "gollum" toJSON (WebhookIssueCommentEvent) = String "issue_comment" toJSON (WebhookIssuesEvent) = String "issues" toJSON (WebhookMemberEvent) = String "member" toJSON (WebhookPageBuildEvent) = String "page_build" toJSON (WebhookPublicEvent) = String "public" toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" toJSON (WebhookPullRequestEvent) = String "pull_request" toJSON (WebhookPushEvent) = String "push" toJSON (WebhookReleaseEvent) = String "release" toJSON (WebhookStatusEvent) = String "status" toJSON (WebhookTeamAddEvent) = String "team_add" toJSON (WebhookWatchEvent) = String "watch" 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.14.1/src/GitHub/Data/Webhooks/Validate.hs0000644000000000000000000000261312650115011017727 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Verification of incomming webhook payloads, as described at -- module GitHub.Data.Webhooks.Validate ( isValidPayload ) where import Prelude () import Prelude.Compat import Crypto.Hash import Data.Byteable (constEqBytes, toBytes) import qualified Data.ByteString.Base16 as Hex import qualified Data.ByteString.Char8 as BS import Data.Monoid -- | Validates a given payload against a given HMAC hexdigest using a given -- secret. -- Returns 'True' iff the given hash is non-empty and it's a valid signature of -- the payload. isValidPayload :: String -- ^ the secret -> Maybe String -- ^ the hash provided by the remote party -- in @X-Hub-Signature@ (if any), -- including the 'sha1=...' prefix -> BS.ByteString -- ^ the body -> Bool isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS where shaOptBS = BS.pack <$> shaOpt hexDigest = Hex.encode . toBytes . hmacGetDigest hm = hmac (BS.pack secret) payload :: HMAC SHA1 sign = "sha1=" <> hexDigest hm github-0.14.1/src/GitHub/Endpoints/Activity/Starring.hs0000644000000000000000000000377612650115011021107 0ustar0000000000000000{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- 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, module GitHub.Data, ) where import Data.Vector (Vector) import GitHub.Auth import GitHub.Data import GitHub.Request -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) stargazersFor auth user repo = executeRequestMaybe auth $ stargazersForR user repo Nothing -- | List Stargazers. -- See stargazersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) stargazersForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = executeRequestMaybe auth $ reposStarredByR user Nothing -- | List repositories being starred. -- See reposStarredByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) reposStarredByR user = PagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = executeRequest auth $ myStarredR Nothing -- | All the repos starred by the authenticated user. myStarredR :: Maybe Count -> Request 'True (Vector Repo) myStarredR = PagedQuery ["user", "starred"] [] github-0.14.1/src/GitHub/Endpoints/Activity/Watching.hs0000644000000000000000000000426112650115011021050 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 Data.Vector (Vector) import GitHub.Auth import GitHub.Data import GitHub.Request -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- -- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo Nothing -- | List watchers. -- See watchersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) watchersForR user repo limit = PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- -- > reposWatchedBy "croaky" reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- -- > reposWatchedBy' (Just (User (user, password))) "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = executeRequestMaybe auth $ reposWatchedByR user Nothing -- | List repositories being watched. -- See reposWatchedByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) reposWatchedByR user = PagedQuery ["users", toPathPart user, "subscriptions"] [] github-0.14.1/src/GitHub/Endpoints/Gists.hs0000644000000000000000000000314612650115011016602 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The gists API as described at . module GitHub.Endpoints.Gists ( gists, gists', gistsR, gist, gist', gistR, module GitHub.Data, ) where import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | The list of all gists created by the user -- -- > gists' (Just ("github-username", "github-password")) "mike-burns" gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = executeRequestMaybe auth $ gistsR user Nothing -- | The list of all public gists created by the user. -- -- > gists "mike-burns" gists :: Name Owner -> IO (Either Error (Vector Gist)) gists = gists' Nothing -- | List gists. -- See gistsR :: Name Owner -> Maybe Count -> Request k (Vector Gist) gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- -- > gist' (Just ("github-username", "github-password")) "225074" gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) gist' auth gid = executeRequestMaybe auth $ gistR gid -- | A specific gist, given its id. -- -- > gist "225074" gist :: Name Gist -> IO (Either Error Gist) gist = gist' Nothing -- | Query a single gist. -- See gistR :: Name Gist ->Request k Gist gistR gid = Query ["gists", toPathPart gid] [] github-0.14.1/src/GitHub/Endpoints/Gists/Comments.hs0000644000000000000000000000255312650115011020370 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the comments on a Gist, given the Gist ID. -- -- > commentsOn "1174060" commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) commentsOn gid = executeRequest' $ commentsOnR gid Nothing -- | List comments on a gist. -- See commentsOnR :: Name Gist -> Maybe Count -> 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.14.1/src/GitHub/Endpoints/GitData/Blobs.hs0000644000000000000000000000230412650115011020062 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.Request -- | Query a blob by SHA1. -- -- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob' auth user repo sha = executeRequestMaybe auth $ blobR user repo sha -- | Query a blob by SHA1. -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob = blob' Nothing -- | 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.14.1/src/GitHub/Endpoints/GitData/Commits.hs0000644000000000000000000000173612650115011020444 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.Request -- | A single commit, by SHA1. -- -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) commit user repo sha = executeRequest' $ gitCommitR user repo sha -- | 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.14.1/src/GitHub/Endpoints/GitData/References.hs0000644000000000000000000000675712650115011021122 0ustar0000000000000000{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . module GitHub.Endpoints.GitData.References ( reference, reference', referenceR, references, references', referencesR, createReference, createReferenceR, namespacedReferences, module GitHub.Data, ) where import Data.Aeson.Compat (encode) import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | A single reference by the ref name. -- -- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference' auth user repo ref = executeRequestMaybe auth $ referenceR user repo ref -- | A single reference by the ref name. -- -- > reference "mike-burns" "github" "heads/master" reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference = reference' Nothing -- | Query a reference. -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = Query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- -- > references "mike-burns" "github" references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references' auth user repo = executeRequestMaybe auth $ referencesR user repo Nothing -- | The history of references for a repo. -- -- > references "mike-burns" "github" references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references = references' Nothing -- | Query all References. -- See referencesR :: Name Owner -> Name Repo -> Maybe Count -> 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 'True 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 -> String -> IO (Either Error [GitReference]) namespacedReferences user repo namespace = executeRequest' $ namespacedReferencesR user repo namespace -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> String -> Request k [GitReference] namespacedReferencesR user repo namespace = Query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] github-0.14.1/src/GitHub/Endpoints/GitData/Trees.hs0000644000000000000000000000427412650115011020113 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module GitHub.Endpoints.GitData.Trees ( tree, tree', treeR, nestedTree, nestedTree', nestedTreeR, module GitHub.Data, ) where import GitHub.Data import GitHub.Request -- | A tree for a SHA1. -- -- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree' auth user repo sha = executeRequestMaybe auth $ treeR user repo sha -- | A tree for a SHA1. -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree = tree' Nothing -- | 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.14.1/src/GitHub/Endpoints/Issues.hs0000644000000000000000000001246612650115011016771 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The issues API as described on . module GitHub.Endpoints.Issues ( issue, issue', issueR, issuesForRepo, issuesForRepo', issuesForRepoR, IssueLimitation(..), createIssue, createIssueR, newIssue, editIssue, editIssueR, editOfIssue, module GitHub.Data, ) where import GitHub.Data import GitHub.Request import Data.Aeson.Compat (encode) import Data.List (intercalate) import Data.Text (Text) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) import qualified Data.ByteString.Char8 as BS8 -- | 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 @IssueLimitation@ data type. -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName issueLimitations = executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations Nothing -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the @IssueLimitation@ data type. -- -- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo :: Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> Maybe Count -> Request k (Vector Issue) issuesForRepoR user reqRepoName issueLimitations = PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = map convert issueLimitations convert AnyMilestone = ("milestone", Just "*") convert NoMilestone = ("milestone", Just "none") convert (MilestoneId n) = ("milestone", Just . BS8.pack $ show n) convert Open = ("state", Just "open") convert OnlyClosed = ("state", Just "closed") convert Unassigned = ("assignee", Just "none") convert AnyAssignment = ("assignee", Just "") convert (AssignedTo u) = ("assignee", Just $ BS8.pack u) convert (Mentions u) = ("mentioned", Just $ BS8.pack u) convert (Labels l) = ("labels", Just . BS8.pack $ intercalate "," l) convert Ascending = ("direction", Just "asc") convert Descending = ("direction", Just "desc") convert (PerPage n) = ("per_page", Just . BS8.pack $ show n) convert (Since t) = ("since", Just . BS8.pack $ formatISO8601 t) -- 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 'True 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 'True Issue editIssueR user repo iss = Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode github-0.14.1/src/GitHub/Endpoints/Issues/Comments.hs0000644000000000000000000000664212650115011020555 0ustar0000000000000000{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github issue comments API from -- . module GitHub.Endpoints.Issues.Comments ( comment, commentR, comments, commentsR, comments', createComment, createCommentR, editComment, editCommentR, module GitHub.Data, ) where import Data.Aeson.Compat (encode) import Data.Text (Text) import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | A specific comment, by ID. -- -- > comment "thoughtbot" "paperclip" 1468184 comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) comment user repo cid = executeRequest' $ commentR user repo cid -- | Query a single comment. -- See commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = Query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 comments :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid Nothing -- | List comments on an issue. -- See commentsR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> 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 'True 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 'True Comment editCommentR user repo commid body = Command Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] github-0.14.1/src/GitHub/Endpoints/Issues/Events.hs0000644000000000000000000000611712650115011020231 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid Nothing -- | List events for an issue. -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector Event) eventsForIssueR user repo iid = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo Nothing -- | List events for a repository. -- See eventsForRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Event) eventsForRepoR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 event :: Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- -- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 event' :: Maybe Auth -> Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid -- | Query a single event. -- See eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event eventR user repo eid = Query ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] [] github-0.14.1/src/GitHub/Endpoints/Issues/Labels.hs0000644000000000000000000002526312650115011020172 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for dealing with labels on Github issues as described on -- . module GitHub.Endpoints.Issues.Labels ( labelsOnRepo, labelsOnRepo', labelsOnRepoR, label, label', labelR, createLabel, createLabelR, updateLabel, updateLabelR, deleteLabel, deleteLabelR, labelsOnIssue, labelsOnIssue', labelsOnIssueR, addLabelsToIssue, addLabelsToIssueR, removeLabelFromIssue, removeLabelFromIssueR, replaceAllLabelsForIssue, replaceAllLabelsForIssueR, removeAllLabelsFromIssue, removeAllLabelsFromIssueR, labelsOnMilestone, labelsOnMilestone', labelsOnMilestoneR, module GitHub.Data, ) where import Prelude () import Prelude.Compat import Data.Aeson.Compat (encode, object, (.=)) import Data.Foldable (toList) import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo using authentication. -- -- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip" labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = executeRequestMaybe auth $ labelsOnRepoR user repo Nothing -- | List all labels for this repository. -- See labelsOnRepoR :: Name Owner -> Name Repo -> Maybe Count -> 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 'True IssueLabel createLabelR user repo lbl color = Command Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] -- | Update a label -- -- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" updateLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color -> IO (Either Error IssueLabel) updateLabel auth user repo oldLbl newLbl color = executeRequest auth $ updateLabelR user repo oldLbl newLbl color -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color -> Request 'True IssueLabel updateLabelR user repo oldLbl newLbl color = Command Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] -- | Delete a label -- -- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug" deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) deleteLabel auth user repo lbl = executeRequest auth $ deleteLabelR user repo lbl -- | Delete a label. -- See deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'True () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- -- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = executeRequestMaybe auth $ labelsOnIssueR user repo iid Nothing -- | List labels on an issue. -- See labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueLabel) labelsOnIssueR 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 'True (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 'True () 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 'True (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 'True () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone given the milestone ID using authentication. -- -- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2) labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = executeRequestMaybe auth $ labelsOnMilestoneR user repo mid Nothing -- | Query labels for every issue in a milestone. -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Maybe Count -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] github-0.14.1/src/GitHub/Endpoints/Issues/Milestones.hs0000644000000000000000000000354112650115011021105 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All milestones in the repo. -- -- > milestones "thoughtbot" "paperclip" milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- -- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = executeRequestMaybe auth $ milestonesR user repo Nothing -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Milestone) milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- -- > milestone "thoughtbot" "paperclip" (Id 2) milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) milestone user repo mid = executeRequest' $ milestoneR user repo mid -- | 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.14.1/src/GitHub/Endpoints/Organizations.hs0000644000000000000000000000441612650115011020341 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org Nothing -- | 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 -> Maybe Count -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR -- | Query an organization. Details on a public organization. Takes the organization's login. -- -- > publicOrganization "thoughtbot" publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing -- | Query an organization. -- See publicOrganizationR :: Name Organization -> Request k Organization publicOrganizationR reqOrganizationName = Query ["orgs", toPathPart reqOrganizationName] [] github-0.14.1/src/GitHub/Endpoints/Organizations/Members.hs0000644000000000000000000000367112654115311021744 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The organization members API as described on -- . module GitHub.Endpoints.Organizations.Members ( membersOf, membersOf', membersOfR, membersOfWithR, module GitHub.Data, ) where import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the users who are members of the specified organization, -- | with or without authentication. -- -- > membersOf' (Just $ OAuth "token") "thoughtbot" membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = executeRequestMaybe auth $ membersOfR org Nothing -- | All the users who are members of the specified organization, -- | without authentication. -- -- > membersOf "thoughtbot" membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser) membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> Maybe Count -> Request k (Vector SimpleUser) membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] where f' = case f of OrgMemberFilter2faDisabled -> "2fa_disabled" OrgMemberFilterAll -> "all" r' = case r of OrgMemberRoleAll -> "all" OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" github-0.14.1/src/GitHub/Endpoints/Organizations/Teams.hs0000644000000000000000000001533512654115311021423 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Owner teams API as described on -- . module GitHub.Endpoints.Organizations.Teams ( teamsOf, teamsOf', teamsOfR, teamInfoFor, teamInfoFor', teamInfoForR, createTeamFor', createTeamForR, editTeam', editTeamR, deleteTeam', deleteTeamR, listTeamMembersR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, addTeamMembershipFor', addTeamMembershipForR, deleteTeamMembershipFor', deleteTeamMembershipForR, listTeamsCurrent', listTeamsCurrentR, module GitHub.Data, ) where import Prelude () import Prelude.Compat import Data.Aeson.Compat (encode) import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. -- When unauthenticated, lists only public teams for an Owner. -- -- > teamsOf' (Just $ OAuth "token") "thoughtbot" teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = executeRequestMaybe auth $ teamsOfR org Nothing -- | List the public teams of an Owner. -- -- > teamsOf "thoughtbot" teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam) teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- | With authentication -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) teamInfoFor' auth tid = executeRequestMaybe auth $ teamInfoForR tid -- | The information for a single team, by team id. -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor :: Id Team -> IO (Either Error Team) teamInfoFor = teamInfoFor' Nothing -- | 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 'True 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 'True 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 'True () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty -- List team members. -- -- See listTeamMembersR :: Id Team -> TeamMemberRole -> Maybe Count -> Request 'True (Vector SimpleUser) listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of TeamMemberRoleAll -> "all" TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" -- | 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 'True 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 'True () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- -- > listTeamsCurrent' (OAuth "token") listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing -- | List user teams. -- See listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team) listTeamsCurrentR = PagedQuery ["user", "teams"] [] github-0.14.1/src/GitHub/Endpoints/PullRequests.hs0000644000000000000000000002132412650115011020157 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The pull requests API as documented at -- . module GitHub.Endpoints.PullRequests ( pullRequestsFor'', 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.Request import Data.Aeson.Compat (Value, encode, object, (.=)) import Data.Vector (Vector) import qualified Data.ByteString.Char8 as BS8 -- | All pull requests for the repo, by owner, repo name, and pull request state. -- | With authentification -- -- > pullRequestsFor' (Just ("github-username", "github-password")) (Just "open") "rails" "rails" -- -- State can be one of @all@, @open@, or @closed@. Default is @open@. -- pullRequestsFor'' :: Maybe Auth -> Maybe String -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor'' auth state user repo = executeRequestMaybe auth $ pullRequestsForR user repo state Nothing -- | All pull requests for the repo, by owner and repo name. -- | With authentification -- -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor' auth = pullRequestsFor'' auth Nothing -- | All pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor = pullRequestsFor'' Nothing Nothing -- | List pull requests. -- See pullRequestsForR :: Name Owner -> Name Repo -> Maybe String -- ^ State -> Maybe Count -> Request k (Vector SimplePullRequest) pullRequestsForR user repo state = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] qs where qs = maybe [] (\s -> [("state", Just . BS8.pack $ s)]) state -- | 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 'True 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 'True PullRequest updatePullRequestR user repo prid epr = Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. -- | With authentification -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. -- -- > pullRequestCommits "thoughtbot" "paperclip" 688 pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Commit) pullRequestCommitsR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. -- | With authentification -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. -- -- > pullRequestFiles "thoughtbot" "paperclip" 688 pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> 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 String -> IO (Either Error MergeResult) mergePullRequest auth user repo prid commitMessage = executeRequest auth $ mergePullRequestR user repo prid commitMessage -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> Request 'True MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] buildCommitMessageMap :: Maybe String -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] buildCommitMessageMap Nothing = object [] github-0.14.1/src/GitHub/Endpoints/PullRequests/ReviewComments.hs0000644000000000000000000000367112650115011023133 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.ReviewComments ( pullRequestReviewCommentsIO, pullRequestReviewCommentsR, pullRequestReviewComment, pullRequestReviewCommentR, module GitHub.Data, ) where import Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the comments on a pull request with the given ID. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256) pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) pullRequestReviewCommentsIO user repo prid = executeRequest' $ pullRequestReviewCommentsR user repo prid Nothing -- | List comments on a pull request. -- See pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Comment) pullRequestReviewCommentsR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- -- > pullRequestReviewComment "thoughtbot" "factory_girl" (Id 301819) pullRequestReviewComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) pullRequestReviewComment user repo cid = executeRequest' $ pullRequestReviewCommentR user repo cid -- | Query a single comment. -- See pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment pullRequestReviewCommentR user repo cid = Query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] github-0.14.1/src/GitHub/Endpoints/Repos.hs0000644000000000000000000003271312650115011016603 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Repos API, as documented at -- module GitHub.Endpoints.Repos ( -- * Querying repositories currentUserRepos, currentUserReposR, userRepos, userRepos', userReposR, organizationRepos, organizationRepos', organizationReposR, repository, repository', repositoryR, contributors, contributors', contributorsR, contributorsWithAnonymous, contributorsWithAnonymous', languagesFor, languagesFor', languagesForR, tagsFor, tagsFor', tagsForR, branchesFor, branchesFor', branchesForR, contentsFor, contentsFor', readmeFor, readmeFor', -- ** Create createRepo', createRepoR, createOrganizationRepo', createOrganizationRepoR, -- ** Edit editRepo, editRepoR, -- ** Delete deleteRepo, deleteRepoR, -- * Data module GitHub.Data, ) where import Prelude () import Prelude.Compat import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) import Data.Vector (Vector) import GitHub.Data import GitHub.Request import qualified Data.ByteString.Char8 as BS8 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 Nothing -- | List your repositories. -- See currentUserReposR :: RepoPublicity -> Maybe Count -> 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 Nothing -- | List user repositories. -- See userReposR :: Name Owner -> RepoPublicity -> Maybe Count -> 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 Nothing -- | List organization repositories. -- See organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> 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. -- -- > userRepo "mike-burns" "github" repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- -- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo -- | Query single repository. -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = Query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- -- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) createRepo' auth nrepo = executeRequest auth $ createRepoR nrepo -- | Create a new repository. -- See createRepoR :: NewRepo -> Request 'True Repo createRepoR nrepo = Command Post ["user", "repos"] (encode nrepo) -- | Create a new repository for an organization. -- -- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) createOrganizationRepo' auth org nrepo = executeRequest auth $ createOrganizationRepoR org nrepo -- | Create a new repository for an organization. -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'True 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 'True 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 Nothing -- | List contributors. -- See contributorsR :: Name Owner -> Name Repo -> Bool -- ^ Include anonymous -> Maybe Count -> 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 Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- -- > languagesFor "mike-burns" "ohlaunch" languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor = languagesFor' Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- With authentication. -- -- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch" languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor' auth user repo = executeRequestMaybe auth $ languagesForR user repo -- | List languages. -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = Query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- -- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = executeRequestMaybe auth $ tagsForR user repo Nothing -- | List tags. -- See tagsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Tag) tagsForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- -- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = executeRequestMaybe auth $ branchesForR user repo Nothing -- | List branches. -- See branchesForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Branch) branchesForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- -- > contentsFor "thoughtbot" "paperclip" "README.md" contentsFor :: Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) contentsFor = contentsFor' Nothing -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- With Authentication -- -- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) contentsFor' auth user repo path ref = executeRequestMaybe auth $ contentsForR user repo path ref contentsForR :: Name Owner -> Name Repo -> String -- ^ file or directory -> Maybe String -- ^ Git commit -> Request k Content contentsForR user repo path ref = Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref -- | The contents of a README file in a repo, given the repo owner and name -- -- > readmeFor "thoughtbot" "paperclip" readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) readmeFor = readmeFor' Nothing -- | The contents of a README file in a repo, given the repo owner and name -- With Authentication -- -- > readmeFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) readmeFor' auth user repo = executeRequestMaybe auth $ readmeForR user repo readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = Query ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | Delete an existing repository. -- -- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo deleteRepoR :: Name Owner -> Name Repo -> Request 'True () deleteRepoR user repo = Command Delete ["repos", toPathPart user, toPathPart repo] mempty github-0.14.1/src/GitHub/Endpoints/Repos/Collaborators.hs0000644000000000000000000000463612650115011021414 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = executeRequestMaybe auth $ collaboratorsOnR user repo Nothing -- | List collaborators. -- See collaboratorsOnR :: Name Owner -> Name Repo -> Maybe Count -> 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.14.1/src/GitHub/Endpoints/Repos/Comments.hs0000644000000000000000000000653512650115011020373 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor = commentsFor' Nothing -- | All the comments on a Github repo. -- With authentication. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor' auth user repo = executeRequestMaybe auth $ commentsForR user repo Nothing -- | List commit comments for a repository. -- See commentsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Comment) commentsForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor = commitCommentsFor' Nothing -- | Just the comments on a specific SHA for a given Github repo. -- With authentication. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor' auth user repo sha = executeRequestMaybe auth $ commitCommentsForR user repo sha Nothing -- | List comments for a single commit. -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> Maybe Count -> 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.14.1/src/GitHub/Endpoints/Repos/Commits.hs0000644000000000000000000001170612650115011020215 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), commitsFor, commitsFor', commitsForR, commitsWithOptionsFor, commitsWithOptionsFor', commitsWithOptionsForR, commit, commit', commitR, diff, diff', diffR, module GitHub.Data, ) where import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text.Encoding as TE import GitHub.Data import GitHub.Request renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ BS8.pack $ formatISO8601 date) renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack $ formatISO8601 date) -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- -- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] -- | List commits on a repository. -- See commitsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- | The commit history for a repo, with commits filtered to satisfy a list of -- query options. -- With authentication. -- -- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo Nothing opts -- | List commits on a repository. -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR 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.14.1/src/GitHub/Endpoints/Repos/Forks.hs0000644000000000000000000000232012650115011017656 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the repos that are forked off the given repo. -- -- > forksFor "thoughtbot" "paperclip" forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- -- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = executeRequestMaybe auth $ forksForR user repo Nothing -- | List forks. -- See forksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Repo) forksForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] github-0.14.1/src/GitHub/Endpoints/Repos/Webhooks.hs0000644000000000000000000001164112650115011020361 0ustar0000000000000000{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The webhooks API, as described at -- -- module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories webhooksFor', webhooksForR, webhookFor', webhookForR, -- ** Create createRepoWebhook', createRepoWebhookR, -- ** Edit editRepoWebhook', editRepoWebhookR, -- ** Test testPushRepoWebhook', testPushRepoWebhookR, pingRepoWebhook', pingRepoWebhookR, -- ** Delete deleteRepoWebhook', deleteRepoWebhookR, ) where import Prelude () import Prelude.Compat import Data.Aeson.Compat (encode) import Data.Vector (Vector) import GitHub.Data import GitHub.Request webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = executeRequest auth $ webhooksForR user repo Nothing -- | List hooks. -- See webhooksForR :: Name Owner -> Name Repo -> Maybe Count -> 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 'True 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 'True 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 'True 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 'True 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 'True () deleteRepoWebhookR user repo hookId = Command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> [String] createBaseWebhookPath user repo hookId = ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String] createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] github-0.14.1/src/GitHub/Endpoints/Search.hs0000644000000000000000000000571312650115011016720 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Search API, as described at -- . module GitHub.Endpoints.Search( searchRepos', searchRepos, searchReposR, searchCode', searchCode, searchCodeR, searchIssues', searchIssues, searchIssuesR, module GitHub.Data, ) where import Data.Text (Text) import qualified Data.Text.Encoding as TE import GitHub.Data import GitHub.Request -- | Perform a repository search. -- With authentication. -- -- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | 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.14.1/src/GitHub/Endpoints/Users.hs0000644000000000000000000000343612650115011016614 0ustar0000000000000000{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Users API, as described at -- . module GitHub.Endpoints.Users ( userInfoFor, userInfoFor', userInfoForR, ownerInfoForR, userInfoCurrent', userInfoCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Request -- | The information for a single user, by login name. -- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" userInfoFor :: Name User -> IO (Either Error User) userInfoFor = executeRequest' . userInfoForR -- | 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 'True User userInfoCurrentR = Query ["user"] [] github-0.14.1/src/GitHub/Endpoints/Users/Followers.hs0000644000000000000000000000275412650115011020572 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 Data.Vector (Vector) import GitHub.Data import GitHub.Request -- | All the users following the given user. -- -- > usersFollowing "mike-burns" usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowing user = executeRequest' $ usersFollowingR user Nothing -- | List followers of a user. -- See usersFollowingR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowedBy user = executeRequest' $ usersFollowedByR user Nothing -- | List users followed by another user. -- See usersFollowedByR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] github-0.14.1/src/GitHub/Request.hs0000644000000000000000000003124512654115311015206 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- 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, parseResponse, parseStatus, getNextUrl, performPagedRequest, ) where import Prelude () import Prelude.Compat #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except (MonadError (..)) #else import Control.Monad.Error (MonadError (..)) #endif import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Compat (FromJSON, eitherDecode) import Data.List (find, intercalate) import Data.Semigroup (Semigroup (..)) import Data.Text (Text) import Data.Vector.Instances () import Network.HTTP.Client (CookieJar, HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, checkStatus, httpLbs, method, newManager, parseUrl, requestBody, requestHeaders, setQueryString) import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, Status (..)) import Network.URI (URI) import qualified Control.Exception as E import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import GitHub.Auth (Auth (..)) import GitHub.Data (Error (..)) import GitHub.Data.Request -- | Execute 'Request' in 'IO' executeRequest :: Auth -> Request k a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr manager auth req #if !MIN_VERSION_http_client(0, 4, 18) closeManager manager #endif pure x -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: Manager -> Auth -> Request k a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ case req of Query {} -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq parseResponse res PagedQuery _ _ l -> do httpReq <- makeHttpRequest (Just auth) req performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length ) l Command m _ _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq case m of Delete -> pure () _ -> parseResponse res StatusQuery sm _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq parseStatus sm . responseStatus $ res where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. executeRequest' :: Request 'False a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req #if !MIN_VERSION_http_client(0, 4, 18) closeManager manager #endif pure x -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' :: Manager -> Request 'False a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ case req of Query {} -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq parseResponse res PagedQuery _ _ l -> do httpReq <- makeHttpRequest Nothing req performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length) l StatusQuery sm _ -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq parseStatus sm . responseStatus $ res where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. executeRequestMaybe :: Maybe Auth -> Request 'False a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. unsafeDropAuthRequirements :: Request 'True a -> Request k a unsafeDropAuthRequirements (Query ps qs) = 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 StatusQuery sm req -> do req' <- makeHttpRequest auth req return $ setCheckStatus (Just sm) req' Query paths qs -> do req <- parseUrl $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req 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 url :: Paths -> String url paths = baseUrl ++ '/' : intercalate "/" paths baseUrl :: String baseUrl = case auth of Just (EnterpriseOAuth endpoint _) -> endpoint _ -> "https://api.github.com" setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request setCheckStatus sm req = req { checkStatus = successOrMissing sm } setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } reqHeaders :: RequestHeaders reqHeaders = maybe [] getOAuthHeader auth <> [("User-Agent", "github.hs/0.7.4")] <> [("Accept", "application/vnd.github.preview")] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass setAuthRequest _ = id getOAuthHeader :: Auth -> RequestHeaders getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] getOAuthHeader _ = [] successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException successOrMissing sm s@(Status sci _) hs cookiejar | check = Nothing | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar where check = case sm of Nothing -> 200 <= sci && sci < 300 Just StatusOnlyOk -> sci == 204 || sci == 404 Just StatusMerge -> sci `elem` [204, 405, 409] -- | 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 StatusOnlyOk (Status sci _) | sci == 204 = return True | sci == 404 = return False | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) parseStatus StatusMerge (Status sci _) | sci == 204 = return MergeSuccessful | sci == 405 = return MergeCannotPerform | sci == 409 = return MergeConflict | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ -- 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' <- setUri req uri res' <- httpLbs' req' m <- parseResponse res' go (acc <> m) res' req' (_, _) -> return acc onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError github-0.14.1/spec/Spec.hs0000644000000000000000000000005412647755744013451 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} github-0.14.1/spec/GitHub/ActivitySpec.hs0000644000000000000000000000212212654115311016320 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where import GitHub.Auth (Auth (..)) 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" Nothing cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) github-0.14.1/spec/GitHub/CommitsSpec.hs0000644000000000000000000000446112654115311016147 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', commitsForR, diffR, mkName) import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) import Data.List (nub, sort) import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, 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" (Just 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" (Just 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 let mkCommitName = mkName (Proxy :: Proxy Commit) d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight github-0.14.1/spec/GitHub/OrganizationsSpec.hs0000644000000000000000000000411412654115311017356 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.Compat (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.14.1/spec/GitHub/ReposSpec.hs0000644000000000000000000000261612654115311015624 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, languagesFor', userRepos') import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import 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 "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.14.1/spec/GitHub/SearchSpec.hs0000644000000000000000000000421212654115311015733 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.SearchSpec where import Prelude () import Prelude.Compat import Data.Aeson.Compat (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 (..), 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` "closed" let issue2 = issues V.! 1 issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 issueNumber issue2 `shouldBe` 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` "open" 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.14.1/spec/GitHub/UsersSpec.hs0000644000000000000000000000574312654115311015641 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where import Data.Aeson.Compat (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 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" (Just 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do us <- executeRequest auth $ usersFollowedByR "phadej" (Just 10) us `shouldSatisfy` isRight github-0.14.1/LICENSE0000644000000000000000000000275512542473570012274 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.14.1/Setup.hs0000644000000000000000000000005612542473570012713 0ustar0000000000000000import Distribution.Simple main = defaultMain github-0.14.1/github.cabal0000644000000000000000000001303612654116142013520 0ustar0000000000000000name: github version: 0.14.1 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.2 cabal-version: >=1.10 extra-source-files: README.md, CHANGELOG.md, fixtures/issue-search.json, fixtures/list-teams.json, fixtures/members-list.json, fixtures/user-organizations.json, fixtures/user.json flag aeson-compat description: Whether to use aeson-compat or aeson-extra default: True manual: False source-repository head type: git location: git://github.com/phadej/github.git Library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src exposed-modules: GitHub GitHub.Auth GitHub.Data GitHub.Data.Comments GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Issues GitHub.Data.Name GitHub.Data.PullRequests GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Search GitHub.Data.Teams GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate 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.ReviewComments GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Followers GitHub.Request -- Packages needed in order to build this package. build-depends: base >= 4.7 && <4.9, aeson >=0.7.0.6 && <0.11, attoparsec >=0.11.3.4 && <0.14, base-compat >=0.6.0 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, binary-orphans >=0.1.0.0 && <0.2, byteable >=0.1.1 && <0.2, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, cryptohash >=0.11 && <0.12, deepseq >=1.3.0.2 && <1.5, deepseq-generics >=0.1.1.2 && <0.3, exceptions >=0.8.0.2 && <0.9, hashable >=1.2.3.3 && <1.3, http-client >=0.4.8.1 && <0.5, http-client-tls >=0.2.2 && <0.3, http-link-header >=1.0.1 && <1.1, http-types >=0.8.6 && <0.10, iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, semigroups >=0.16.2.2 && <0.19, text >=1.2.0.6 && <1.3, time >=1.4 && <1.7, transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, vector >=0.10.12.3 && <0.12, vector-instances >=3.3.0.1 && <3.4 if flag(aeson-compat) build-depends: aeson-compat >=0.3.0.0 && <0.4 else build-depends: aeson-extra >=0.2.0.0 && <0.3 test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec other-modules: GitHub.ActivitySpec GitHub.CommitsSpec GitHub.OrganizationsSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec main-is: Spec.hs ghc-options: -Wall build-depends: base, base-compat, github, vector, unordered-containers, file-embed, hspec if flag(aeson-compat) build-depends: aeson-compat else build-depends: aeson-extra github-0.14.1/README.md0000644000000000000000000000530512654115311012526 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)](http://hackage.haskell.org/package/github) [![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. 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 import qualified GitHub.Endpoints.Users.Followers as Github main = do possibleUsers <- GitHub.usersFollowing "mike-burns" T.putStrLn $ either (("Error: " <>) . T.pack . show) (foldMap (formatUser . (<> "\n"))) possibleUsers formatUser = GitHub.untagName . GitHub.githubOwnerLogin ``` 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. github-0.14.1/CHANGELOG.md0000644000000000000000000000524312654115311013061 0ustar0000000000000000Changes 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.14.1/fixtures/issue-search.json0000644000000000000000000001306212647713071016416 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, "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, "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.14.1/fixtures/list-teams.json0000644000000000000000000000053712642277032016105 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.14.1/fixtures/members-list.json0000644000000000000000000000170412642277032016423 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.14.1/fixtures/user-organizations.json0000644000000000000000000000032212642245447017663 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.14.1/fixtures/user.json0000644000000000000000000000244312637453326015005 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" }