github 0.8 → 0.9

raw patch · 20 files changed

+527/−62 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Github/Auth.hs +4/−0
• Github/Data.hs +73/−6
• Github/Data/Definitions.hs +66/−3
• Github/Events.hs +13/−0
• Github/Issues.hs +0/−6
• Github/Issues/Comments.hs +0/−6
• Github/Private.hs +23/−1
• Github/Repos.hs +84/−27
• Github/Repos/Webhooks.hs +116/−0
• Github/Search.hs +0/−1
• README.md +18/−8
• github.cabal +12/−2
• samples/Repos/Webhooks/CreateWebhook.hs +24/−0
• samples/Repos/Webhooks/DeleteWebhook.hs +12/−0
• samples/Repos/Webhooks/EditWebhook.hs +23/−0
• samples/Repos/Webhooks/ListWebhook.hs +16/−0
• samples/Repos/Webhooks/ListWebhooks.hs +17/−0
• samples/Repos/Webhooks/PingWebhook.hs +12/−0
• samples/Repos/Webhooks/TestPushWebhook.hs +12/−0
• samples/Users/ShowUser.hs +2/−2

@@ -0,0 +1,4 @@+-- | The Github auth data type+module Github.Auth (P.GithubAuth(..)) where++import qualified Github.Private as P

@@ -11,7 +11,6 @@ import Control.Monad import qualified Data.Text as T import Data.Aeson.Types-import Data.Monoid import System.Locale (defaultTimeLocale) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map@@ -383,7 +382,7 @@         <*> o .: "base"         <*> o .: "commits"         <*> o .: "merged"-        <*> o .: "mergeable"+        <*> o .:? "mergeable"   parseJSON _ = fail "Could not build a DetailedPullRequest"  instance FromJSON PullRequestLinks where@@ -395,10 +394,37 @@   parseJSON _ = fail "Could not build a PullRequestLinks"  instance FromJSON PullRequestCommit where-  parseJSON (Object _) =-    return PullRequestCommit+  parseJSON (Object o) =+    PullRequestCommit <$> o .: "label"+                      <*> o .: "ref"+                      <*> o .: "sha"+                      <*> o .: "user"+                      <*> o .: "repo"   parseJSON _ = fail "Could not build a PullRequestCommit" +instance FromJSON PullRequestEvent where+  parseJSON (Object o) =+    PullRequestEvent <$> o .: "action"+                     <*> o .: "number"+                     <*> o .: "pull_request"+                     <*> o .: "repository"+                     <*> o .: "sender"+  parseJSON _ = fail "Could not build a PullRequestEvent"++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 _ = fail "Could not build a PullRequestEventType"++instance FromJSON PingEvent where+  parseJSON (Object o) =+    PingEvent <$> o .: "zen"+              <*> o .: "hook"+              <*> o .: "hook_id"+  parseJSON _ = fail "Could not build a PingEvent"+ instance FromJSON SearchReposResult where   parseJSON (Object o) =     SearchReposResult <$> o .: "total_count"@@ -434,6 +460,7 @@          <*> o .:? "has_downloads" 	 <*> o .:? "parent" 	 <*> o .:? "source"+         <*> o .: "hooks_url"   parseJSON _ = fail "Could not build a Repo"  instance FromJSON RepoRef where@@ -505,7 +532,7 @@                    <*> o .: "avatar_url"                    <*> o .: "followers"                    <*> o .: "following"-                   <*> o .: "hireable"+                   <*> o .:? "hireable"                    <*> o .: "gravatar_id"                    <*> o .:? "blog"                    <*> o .:? "bio"@@ -513,14 +540,53 @@                    <*> o .:? "name"                    <*> o .:? "location"                    <*> o .:? "company"-                   <*> o .: "email"+                   <*> o .:? "email"                    <*> o .: "url"                    <*> o .: "id"                    <*> o .: "html_url"                    <*> o .: "login"   parseJSON _ = fail "Could not build a DetailedOwner" +instance FromJSON RepoWebhook where+  parseJSON (Object o) =+    RepoWebhook <$> o .: "url"+                <*> o .: "test_url"+                <*> o .: "id"+                <*> o .: "name"+                <*> o .: "active"+                <*> o .: "events"+                <*> o .: "config"+                <*> o .: "last_response"+                <*> o .: "updated_at"+                <*> o .: "created_at"+  parseJSON _          = fail "Could not build a RepoWebhook" +instance FromJSON RepoWebhookResponse where+  parseJSON (Object o) =+    RepoWebhookResponse <$> o .: "code"+                        <*> o .: "status"+                        <*> o .: "message"+  parseJSON _          = fail "Could not build a RepoWebhookResponse"++instance FromJSON Content where+  parseJSON o@(Object _) = ContentFile <$> parseJSON o+  parseJSON (Array os) = ContentDirectory <$> (mapM parseJSON $ V.toList os)+  parseJSON _ = fail "Could not build a Content"++instance FromJSON ContentData where+  parseJSON (Object o) =+    ContentData <$> o .: "type"+                <*> o .: "encoding"+                <*> o .: "size"+                <*> o .: "name"+                <*> o .: "path"+                <*> o .: "content"+                <*> o .: "sha"+                <*> o .: "url"+                <*> o .: "git_url"+                <*> o .: "html_url"+  parseJSON _ = fail "Could not build a ContentData"+ -- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead -- of `Nothing'. (.:<) :: (FromJSON a) => Object -> T.Text -> Parser [a]@@ -540,6 +606,7 @@ obj <.:> (key:keys) =   let (Object nextObj) = findWithDefault (Object Map.empty) key obj in       nextObj <.:> keys+_ <.:> [] = fail "must have a pair"  -- | Produce the value for the given key, maybe. at :: Object -> T.Text -> Maybe Value

@@ -5,6 +5,7 @@ import Data.Time import Data.Data import qualified Control.Exception as E+import qualified Data.Map as M  -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them.@@ -351,7 +352,7 @@   ,detailedPullRequestBase :: PullRequestCommit   ,detailedPullRequestCommits :: Int   ,detailedPullRequestMerged :: Bool-  ,detailedPullRequestMergeable :: Bool+  ,detailedPullRequestMergeable :: Maybe Bool } deriving (Show, Data, Typeable, Eq, Ord)  data PullRequestLinks = PullRequestLinks {@@ -362,6 +363,11 @@ } deriving (Show, Data, Typeable, Eq, Ord)  data PullRequestCommit = PullRequestCommit {+   pullRequestCommitLabel :: String+  ,pullRequestCommitRef :: String+  ,pullRequestCommitSha :: String+  ,pullRequestCommitUser :: GithubOwner+  ,pullRequestCommitRepo :: Repo } deriving (Show, Data, Typeable, Eq, Ord)  data SearchReposResult = SearchReposResult {@@ -397,11 +403,28 @@   ,repoHasDownloads :: Maybe Bool   ,repoParent :: Maybe RepoRef   ,repoSource :: Maybe RepoRef+  ,repoHooksUrl :: String } deriving (Show, Data, Typeable, Eq, Ord)  data RepoRef = RepoRef GithubOwner String -- Repo owner and name  deriving (Show, Data, Typeable, Eq, Ord) +data Content = ContentFile ContentData | ContentDirectory [ContentData]+ deriving (Show, Data, Typeable, Eq, Ord)++data ContentData = ContentData {+   contentType :: String+  ,contentEncoding :: String+  ,contentSize :: Int+  ,contentName :: String+  ,contentPath :: String+  ,contentData :: String+  ,contentSha :: String+  ,contentUrl :: String+  ,contentGitUrl :: String+  ,contentHtmlUrl :: String+} deriving (Show, Data, Typeable, Eq, Ord)+ data Contributor   -- | An existing Github user, with their number of contributions, avatar   -- URL, login, URL, ID, and Gravatar ID.@@ -443,7 +466,7 @@   ,detailedOwnerAvatarUrl :: String   ,detailedOwnerFollowers :: Int   ,detailedOwnerFollowing :: Int-  ,detailedOwnerHireable :: Bool+  ,detailedOwnerHireable :: Maybe Bool   ,detailedOwnerGravatarId :: Maybe String   ,detailedOwnerBlog :: Maybe String   ,detailedOwnerBio :: Maybe String@@ -451,7 +474,7 @@   ,detailedOwnerName :: Maybe String   ,detailedOwnerLocation :: Maybe String   ,detailedOwnerCompany :: Maybe String-  ,detailedOwnerEmail :: String+  ,detailedOwnerEmail :: Maybe String   ,detailedOwnerUrl :: String   ,detailedOwnerId :: Int   ,detailedOwnerHtmlUrl :: String@@ -474,4 +497,44 @@   ,detailedOwnerId :: Int   ,detailedOwnerHtmlUrl :: String   ,detailedOwnerLogin :: String+} deriving (Show, Data, Typeable, Eq, Ord)++data RepoWebhook = RepoWebhook {+   repoWebhookUrl :: String+  ,repoWebhookTestUrl :: String+  ,repoWebhookId :: Integer+  ,repoWebhookName :: String+  ,repoWebhookActive :: Bool+  ,repoWebhookEvents :: [String]+  ,repoWebhookConfig :: M.Map String String+  ,repoWebhookLastResponse :: RepoWebhookResponse+  ,repoWebhookUpdatedAt :: GithubDate+  ,repoWebhookCreatedAt :: GithubDate+} deriving (Show, Data, Typeable, Eq, Ord)++data RepoWebhookResponse = RepoWebhookResponse {+   repoWebhookResponseCode :: Maybe Int+  ,repoWebhookResponseStatus :: String+  ,repoWebhookResponseMessage :: Maybe String+} deriving (Show, Data, Typeable, Eq, Ord)++data PullRequestEvent = PullRequestEvent {+   pullRequestEventAction :: PullRequestEventType+  ,pullRequestEventNumber :: Int+  ,pullRequestEventPullRequest :: DetailedPullRequest+  ,pullRequestRepository :: Repo+  ,pullRequestSender :: GithubOwner+} deriving (Show, Data, Typeable, Eq, Ord)++data PullRequestEventType =+    PullRequestOpened+  | PullRequestClosed+  | PullRequestSynchronized+  | PullRequestReopened+  deriving (Show, Data, Typeable, Eq, Ord)++data PingEvent = PingEvent {+   pingEventZen :: String+  ,pingEventHook :: RepoWebhook+  ,pingEventHookId :: Int } deriving (Show, Data, Typeable, Eq, Ord)

@@ -0,0 +1,13 @@+module Github.Events (+ parseEvent+) where++import qualified Data.ByteString.Lazy.Char8 as LBS++import Data.Aeson (FromJSON)++import Github.Data.Definitions (Error(..))+import Github.Private (parseJson)++parseEvent :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b+parseEvent = parseJson

@@ -6,12 +6,6 @@ ,issuesForRepo ,issuesForRepo' ,IssueLimitation(..)---- * Modifying Issues--- |--- Only authenticated users may create and edit issues.-,GithubAuth(..)- ,createIssue ,newIssue ,editIssue

@@ -4,12 +4,6 @@  comment ,comments ,comments'---- * Modifying Comments--- |--- Only authenticated users may create and edit comments.-,GithubAuth(..)- ,createComment ,editComment ,module Github.Data

@@ -12,7 +12,7 @@ import Data.CaseInsensitive (mk) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS-import Network.HTTP.Types (Method, Status(..))+import Network.HTTP.Types (Status(..), notFound404) import Network.HTTP.Conduit -- import Data.Conduit (ResourceT) import qualified Control.Exception as E@@ -115,6 +115,7 @@                     , secure = True                     , port = 443                     , requestBody = reqBody+                    , responseTimeout = Just 20000000                     , requestHeaders = reqHeaders <>                                        [("User-Agent", "github.hs/0.7.4")]                                        <> [("Accept", "application/vnd.github.preview")]@@ -148,6 +149,27 @@ #else       | otherwise = Just $ E.toException $ StatusCodeException s hs #endif++doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status)+doHttpsStatus reqMethod url auth payload = do+  result <- doHttps reqMethod url (Just auth) payload+  case result of+    Left e -> return (Left (HTTPConnectionError e))+    Right resp ->+      let status = responseStatus resp+          headers = responseHeaders resp+      in if status == notFound404+            -- doHttps silently absorbs 404 errors, but for this operation+            -- we want the user to know if they've tried to delete a+            -- non-existent repository+         then return (Left (HTTPConnectionError+                            (E.toException+                             (StatusCodeException status headers+#if MIN_VERSION_http_conduit(1, 9, 0)+                                 (responseCookieJar resp)+#endif+                                 ))))+             else return (Right status)  parseJsonRaw :: LBS.ByteString -> Either Error Value parseJsonRaw jsonString =

@@ -14,18 +14,20 @@ ,organizationRepo ,organizationRepo' ,contributors+,contributors' ,contributorsWithAnonymous+,contributorsWithAnonymous' ,languagesFor+,languagesFor' ,tagsFor+,tagsFor' ,branchesFor+,branchesFor'+,contentsFor+,contentsFor' ,module Github.Data ,RepoPublicity(..) --- * Modifying repositories--- |--- Only authenticated users may modify repositories.-,GithubAuth(..)- -- ** Create ,createRepo ,createOrganizationRepo@@ -68,9 +70,9 @@ userRepos = userRepos' Nothing  -- | The repos for a user, by their login.--- | With authentication, but note that private repos are currently not supported.+-- With authentication, but note that private repos are currently not supported. ----- > userRepos' (Just (GithubUser (user, password))) "mike-burns" All+-- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) userRepos' auth userName All =   githubGetWithQueryString' auth ["users", userName, "repos"] "type=all"@@ -90,9 +92,9 @@ organizationRepos = organizationRepos' Nothing  -- | The repos for an organization, by the organization name.--- | With authentication+-- With authentication. ----- > organizationRepos (Just (GithubUser (user, password))) "thoughtbot"+-- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"] @@ -103,9 +105,9 @@ organizationRepo = organizationRepo' Nothing  -- | A specific organization repo, by the organization name.--- | With authentication+-- With authentication. ----- > organizationRepo (Just (GithubUser (user, password))) "thoughtbot" "github"+-- > organizationRepo (Just (GithubBasicAuth (user, password))) "thoughtbot" "github" organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) organizationRepo' auth orgName reqRepoName = githubGet' auth ["orgs", orgName, reqRepoName] @@ -116,9 +118,9 @@ userRepo = userRepo' Nothing  -- | Details on a specific repo, given the owner and repo name.--- | With authentication+-- With authentication. ----- > userRepo' (Just (GithubUser (user, password))) "mike-burns" "github"+-- > userRepo' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName] @@ -126,44 +128,99 @@ -- -- > contributors "thoughtbot" "paperclip" contributors :: String -> String -> IO (Either Error [Contributor])-contributors userName reqRepoName =-  githubGet ["repos", userName, reqRepoName, "contributors"]+contributors = contributors' Nothing +-- | The contributors to a repo, given the owner and repo name.+-- With authentication.+--+-- > contributors' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"+contributors' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor])+contributors' auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "contributors"]+ -- | 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 :: String -> String -> IO (Either Error [Contributor])-contributorsWithAnonymous userName reqRepoName =-  githubGetWithQueryString+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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"+contributorsWithAnonymous' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor])+contributorsWithAnonymous' auth userName reqRepoName =+  githubGetWithQueryString' auth     ["repos", userName, reqRepoName, "contributors"]     "anon=true" + -- | 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 :: String -> String -> IO (Either Error [Language])-languagesFor userName reqRepoName = do-  result <- githubGet ["repos", userName, reqRepoName, "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 (GithubBasicAuth (user, password))) "mike-burns" "ohlaunch"+languagesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Language])+languagesFor' auth userName reqRepoName = do+  result <- githubGet' auth ["repos", userName, reqRepoName, "languages"]   return $ either Left (Right . getLanguages) result  -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" tagsFor :: String -> String -> IO (Either Error [Tag])-tagsFor userName reqRepoName =-  githubGet ["repos", userName, reqRepoName, "tags"]+tagsFor = tagsFor' Nothing +-- | The git tags on a repo, given the repo owner and name.+-- With authentication.+--+-- > tagsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"+tagsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Tag])+tagsFor' auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "tags"]+ -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" branchesFor :: String -> String -> IO (Either Error [Branch])-branchesFor userName reqRepoName =-  githubGet ["repos", userName, reqRepoName, "branches"]+branchesFor = branchesFor' Nothing +-- | The git branches on a repo, given the repo owner and name.+-- With authentication.+--+-- > branchesFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip"+branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch])+branchesFor' auth userName reqRepoName =+  githubGet' auth ["repos", userName, reqRepoName, "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 :: String -> String -> 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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md"+contentsFor' :: Maybe GithubAuth ->  String -> String -> String -> Maybe String -> IO (Either Error Content)+contentsFor' auth userName repoName path ref =+  githubGetWithQueryString' auth+  ["repos", userName, repoName, "contents", path] $+  maybe "" ("ref="++) ref++ data NewRepo = NewRepo {   newRepoName         :: String , newRepoDescription  :: (Maybe String)@@ -198,14 +255,14 @@ -- | -- Create a new repository. ----- > createRepo (GithubUser (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False}+-- > createRepo (GithubBasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} createRepo :: GithubAuth -> NewRepo -> IO (Either Error Repo) createRepo auth = githubPost auth ["user", "repos"]  -- | -- Create a new repository for an organization. ----- > createOrganizationRepo (GithubUser (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False}+-- > createOrganizationRepo (GithubBasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} createOrganizationRepo :: GithubAuth -> String -> NewRepo -> IO (Either Error Repo) createOrganizationRepo auth org = githubPost auth ["orgs", org, "repos"] @@ -243,7 +300,7 @@ -- | -- Edit an existing repository. ----- > editRepo (GithubUser (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"}+-- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} editRepo :: GithubAuth      -> String      -- ^ owner      -> String      -- ^ repository name@@ -257,7 +314,7 @@ -- | -- Delete an existing repository. ----- > deleteRepo (GithubUser (user, password)) "thoughtbot" "some_repo"+-- > deleteRepo (GithubBasicAuth (user, password)) "thoughtbot" "some_repo" deleteRepo :: GithubAuth            -> String      -- ^ owner            -> String      -- ^ repository name

@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+-- | The webhooks API, as described at+-- <https://developer.github.com/v3/repos/hooks/>+-- <https://developer.github.com/webhooks>++module Github.Repos.Webhooks (++-- * Querying repositories+  webhooksFor'+ ,webhookFor'++-- ** Create+ ,createRepoWebhook'++-- ** Edit  + ,editRepoWebhook'++-- ** Test  + ,testPushRepoWebhook'+ ,pingRepoWebhook'++-- ** Delete  + ,deleteRepoWebhook'+ ,NewRepoWebhook(..)+ ,EditRepoWebhook(..)+ ,RepoOwner+ ,RepoName+ ,RepoWebhookId+) where++import Github.Data+import Github.Private+import qualified Data.Map as M+import Network.HTTP.Conduit+import Network.HTTP.Types+import Data.Aeson++type RepoOwner = String+type RepoName = String+type RepoWebhookId = Int++data NewRepoWebhook = NewRepoWebhook {+  newRepoWebhookName :: String+ ,newRepoWebhookConfig :: M.Map String String+ ,newRepoWebhookEvents :: Maybe [String]+ ,newRepoWebhookActive :: Maybe Bool+} deriving Show++data EditRepoWebhook = EditRepoWebhook {+  editRepoWebhookConfig :: Maybe (M.Map String String)+ ,editRepoWebhookEvents :: Maybe [String]+ ,editRepoWebhookAddEvents :: Maybe [String]+ ,editRepoWebhookRemoveEvents :: Maybe [String]+ ,editRepoWebhookActive :: Maybe Bool+} deriving Show+                  +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+             ]+             +webhooksFor' :: GithubAuth -> RepoOwner -> RepoName -> IO (Either Error [RepoWebhook])+webhooksFor' auth owner reqRepoName =+  githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks"]++webhookFor' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error RepoWebhook)+webhookFor' auth owner reqRepoName webhookId =+  githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks", (show webhookId)]++createRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> NewRepoWebhook -> IO (Either Error RepoWebhook)+createRepoWebhook' auth owner reqRepoName = githubPost auth ["repos", owner, reqRepoName, "hooks"]++editRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> EditRepoWebhook -> IO (Either Error RepoWebhook)+editRepoWebhook' auth owner reqRepoName webhookId edit = githubPatch auth ["repos", owner, reqRepoName, "hooks", (show webhookId)] edit+                                                            +testPushRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status)+testPushRepoWebhook' auth owner reqRepoName webhookId =+  doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "tests")) auth (Just . RequestBodyLBS . encode $ (decode "{}" :: Maybe (M.Map String Int))) ++pingRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status)+pingRepoWebhook' auth owner reqRepoName webhookId =+  doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "pings")) auth Nothing++deleteRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status)+deleteRepoWebhook' auth owner reqRepoName webhookId =+  doHttpsStatus "DELETE" (createWebhookOpUrl owner reqRepoName webhookId Nothing) auth Nothing++createBaseWebhookUrl :: RepoOwner -> RepoName -> RepoWebhookId -> String+createBaseWebhookUrl owner reqRepoName webhookId = "https://api.github.com/repos/" ++ owner ++ "/" ++ reqRepoName ++ "/hooks/" ++ (show webhookId)++createWebhookOpUrl :: RepoOwner -> RepoName -> RepoWebhookId -> Maybe String -> String+createWebhookOpUrl owner reqRepoName webhookId Nothing = createBaseWebhookUrl owner reqRepoName webhookId+createWebhookOpUrl owner reqRepoName webhookId (Just operation) = createBaseWebhookUrl owner reqRepoName webhookId ++ "/" ++ operation

@@ -4,7 +4,6 @@  searchRepos' ,searchRepos ,module Github.Data-,GithubAuth(..) ) where  import Github.Data

@@ -22,35 +22,45 @@ Example Usage ============= -See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory.+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/).+Each module lines up with the hierarchy of+[documentation from the Github API](http://developer.github.com/v3/).  Each function has a sample written for it. -All 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:+All 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: -    import Github.Users.Followers+    import qualified Github.Users.Followers as Github     import Data.List (intercalate)+     main = do-      possibleUsers <- usersFollowing "mike-burns"-      putStrLn $ either (\error -> "Error: " ++ $ show error)-                        (intercalate "\n" . map githubUserLogin)+      possibleUsers <- Github.usersFollowing "mike-burns"+      putStrLn $ either (("Error: "++) . show)+                        (intercalate "\n" . map formatUser)                         possibleUsers +    formatUser = Github.githubOwnerLogin+ Contributions ============= -Please see [CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) for details on how you can help.+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-2014 John Wiegley.  Available under the BSD 3-clause license.

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.8+Version:             0.9  -- A short (one-line) description of the package. Synopsis:            Access to the Github API, v3.@@ -98,6 +98,13 @@                     ,samples/Repos/Watching/ListWatched.hs                     ,samples/Repos/Watching/ListWatchers.hs                     ,samples/Repos/Starring/ListStarred.hs+                    ,samples/Repos/Webhooks/CreateWebhook.hs+                    ,samples/Repos/Webhooks/DeleteWebhook.hs+                    ,samples/Repos/Webhooks/EditWebhook.hs+                    ,samples/Repos/Webhooks/ListWebhook.hs+                    ,samples/Repos/Webhooks/ListWebhooks.hs+                    ,samples/Repos/Webhooks/PingWebhook.hs+                    ,samples/Repos/Webhooks/TestPushWebhook.hs                     ,samples/Users/Followers/ListFollowers.hs                     ,samples/Users/Followers/ListFollowing.hs                     ,samples/Users/ShowUser.hs@@ -113,8 +120,10 @@  Library   -- Modules exported by the library.-  Exposed-modules: Github.Data,+  Exposed-modules: Github.Auth,+                   Github.Data,                    Github.Data.Definitions,+                   Github.Events,                    Github.Gists,                    Github.Gists.Comments,                    Github.GitData.Commits,@@ -135,6 +144,7 @@                    Github.Repos.Forks,                    Github.Repos.Watching,                    Github.Repos.Starring,+                   Github.Repos.Webhooks                    Github.Users,                    Github.Users.Followers                    Github.Search

@@ -0,0 +1,24 @@+module CreateWebhook where++import Github.Repos.Webhooks+import qualified Github.Auth as Auth+import Github.Data.Definitions+import qualified Data.Map as M++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  let config = M.fromList [("url", "https://foo3.io"), ("content_type", "application/json"), ("insecure_ssl", "1")]+  let webhookDef = NewRepoWebhook {+        newRepoWebhookName = "web",+        newRepoWebhookConfig = config,+        newRepoWebhookEvents = Just ["*"],+        newRepoWebhookActive = Just True+      }+  newWebhook <- createRepoWebhook' auth "repoOwner" "repoName" webhookDef+  case newWebhook of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right webhook) -> putStrLn $ formatRepoWebhook webhook++formatRepoWebhook :: RepoWebhook -> String+formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name

@@ -0,0 +1,12 @@+module DeleteWebhook where++import Github.Repos.Webhooks+import qualified Github.Auth as Auth++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  resp <- deleteRepoWebhook' auth "repoOwner" "repoName" 123+  case resp of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right stat) -> putStrLn $ "Resp: " ++ (show stat)

@@ -0,0 +1,23 @@+module EditWebhook where++import Github.Repos.Webhooks+import qualified Github.Auth as Auth+import Github.Data.Definitions++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  let editWebhookDef = EditRepoWebhook {+        editRepoWebhookRemoveEvents = Just ["*"],+        editRepoWebhookAddEvents = Just ["commit_comment"],+        editRepoWebhookConfig = Nothing,+        editRepoWebhookEvents = Nothing,+        editRepoWebhookActive = Just True+      }+  newWebhook <- editRepoWebhook' auth "repoOwner" "repoName" 123 editWebhookDef+  case newWebhook of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right webhook) -> putStrLn $ formatRepoWebhook webhook++formatRepoWebhook :: RepoWebhook -> String+formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name

@@ -0,0 +1,16 @@+module ListWebhook where++import qualified Github.Repos.Webhooks as W+import qualified Github.Auth as Auth+import qualified Github.Data.Definitions as Def++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  possibleWebhook <- W.webhookFor' auth "repoOwner" "repoName" 123+  case possibleWebhook of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right webhook) -> putStrLn $ formatRepoWebhook webhook++formatRepoWebhook :: Def.RepoWebhook -> String+formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name

@@ -0,0 +1,17 @@+module ListWebhooks where++import qualified Github.Repos.Webhooks as W+import qualified Github.Auth as Auth+import qualified Github.Data.Definitions as Def+import Data.List++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  possibleWebhooks <- W.webhooksFor' auth "repoOwner" "repoName"+  case possibleWebhooks of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right webhooks) -> putStrLn $ intercalate "\n" $ map formatRepoWebhook webhooks++formatRepoWebhook :: Def.RepoWebhook -> String+formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name

@@ -0,0 +1,12 @@+module PingWebhook where++import Github.Repos.Webhooks+import qualified Github.Auth as Auth++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  resp <- pingRepoWebhook' auth "repoOwner" "repoName" 123+  case resp of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right stat) -> putStrLn $ "Resp: " ++ (show stat)

@@ -0,0 +1,12 @@+module TestPushWebhook where++import Github.Repos.Webhooks+import qualified Github.Auth as Auth++main :: IO ()+main = do+  let auth = Auth.GithubOAuth "oauthtoken"+  resp <- testPushRepoWebhook' auth "repoOwner" "repoName" 123+  case resp of+    (Left err) -> putStrLn $ "Error: " ++ (show err)+    (Right stat) -> putStrLn $ "Resp: " ++ (show stat)

@@ -27,9 +27,9 @@ formatUser user@(Github.DetailedUser {}) =   (formatName userName login) ++ "\t" ++ (fromMaybe "" company) ++ "\t" ++     (fromMaybe "" location) ++ "\n" ++-    (fromMaybe "" blog) ++ "\t" ++ "<" ++ email ++ ">" ++ "\n" +++    (fromMaybe "" blog) ++ "\t" ++ "<" ++ (fromMaybe "" email) ++ ">" ++ "\n" ++     htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++-    "hireable: " ++ (formatHireable isHireable) ++ "\n\n" +++    "hireable: " ++ (formatHireable (fromMaybe False isHireable)) ++ "\n\n" ++     (fromMaybe "" bio)   where     userName = Github.detailedOwnerName user