{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- | The webhooks API, as described at -- -- 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 [RepoWebhookEvent] ,newRepoWebhookActive :: Maybe Bool } deriving Show data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: Maybe (M.Map String String) ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent] ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] ,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