{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- | The Github Repos API, as documented at -- module Github.Repos ( -- * Querying repositories userRepos ,userRepos' ,userRepo ,userRepo' ,organizationRepos ,organizationRepos' ,organizationRepo ,organizationRepo' ,contributors ,contributors' ,contributorsWithAnonymous ,contributorsWithAnonymous' ,languagesFor ,languagesFor' ,tagsFor ,tagsFor' ,branchesFor ,branchesFor' ,contentsFor ,contentsFor' ,module Github.Data ,RepoPublicity(..) -- ** Create ,createRepo ,createOrganizationRepo ,newRepo ,NewRepo(..) -- ** Edit ,editRepo ,def ,Edit(..) -- ** Delete ,deleteRepo ) where import Data.Default import Data.Aeson.Types import Github.Data import Github.Private import Network.HTTP.Conduit import Control.Applicative import qualified Control.Exception as E import Network.HTTP.Types -- | Filter the list of the user's repos using any of these constructors. data RepoPublicity = All -- ^ All repos accessible to the user. | Owner -- ^ Only repos owned by the user. | Public -- ^ Only public repos. | Private -- ^ Only private repos. | Member -- ^ Only repos to which the user is a member but not an owner. deriving (Show, Eq) -- | The repos for a user, by their login. Can be restricted to just repos they -- own, are a member of, or publicize. Private repos are currently not -- supported. -- -- > userRepos "mike-burns" All userRepos :: String -> RepoPublicity -> IO (Either Error [Repo]) userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication, but note that private repos are currently not supported. -- -- > 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" userRepos' auth userName Owner = githubGetWithQueryString' auth ["users", userName, "repos"] "type=owner" userRepos' auth userName Member = githubGetWithQueryString' auth ["users", userName, "repos"] "type=member" userRepos' auth userName Public = githubGetWithQueryString' auth ["users", userName, "repos"] "type=public" userRepos' _auth _userName Private = return $ Left $ UserError "Cannot access private repos using userRepos" -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" organizationRepos :: String -> IO (Either Error [Repo]) organizationRepos = organizationRepos' Nothing -- | The repos for an organization, by the organization name. -- With authentication. -- -- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"] -- | A specific organization repo, by the organization name. -- -- > organizationRepo "thoughtbot" "github" organizationRepo :: String -> String -> IO (Either Error Repo) organizationRepo = organizationRepo' Nothing -- | A specific organization repo, by the organization name. -- With authentication. -- -- > 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] -- | Details on a specific repo, given the owner and repo name. -- -- > userRepo "mike-burns" "github" userRepo :: String -> String -> IO (Either Error Repo) userRepo = userRepo' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- -- > 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] -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" contributors :: String -> String -> IO (Either Error [Contributor]) 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 = 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 = 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 = 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 = 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 reqRepoName reqContentPath ref = githubGetWithQueryString' auth ["repos", userName, reqRepoName, "contents", reqContentPath] $ maybe "" ("ref="++) ref data NewRepo = NewRepo { newRepoName :: String , newRepoDescription :: (Maybe String) , newRepoHomepage :: (Maybe String) , newRepoPrivate :: (Maybe Bool) , newRepoHasIssues :: (Maybe Bool) , newRepoHasWiki :: (Maybe Bool) , newRepoAutoInit :: (Maybe Bool) } deriving Show 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 ] newRepo :: String -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing -- | -- Create a new repository. -- -- > 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 (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"] data Edit = Edit { editName :: Maybe String , editDescription :: Maybe String , editHomepage :: Maybe String , editPublic :: Maybe Bool , editHasIssues :: Maybe Bool , editHasWiki :: Maybe Bool , editHasDownloads :: Maybe Bool } deriving Show instance Default Edit where def = Edit def def def def def def def instance ToJSON Edit where toJSON (Edit { 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 ] -- | -- Edit an existing repository. -- -- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} editRepo :: GithubAuth -> String -- ^ owner -> String -- ^ repository name -> Edit -> IO (Either Error Repo) editRepo auth user repo body = githubPatch auth ["repos", user, repo] b where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} -- | -- Delete an existing repository. -- -- > deleteRepo (GithubBasicAuth (user, password)) "thoughtbot" "some_repo" deleteRepo :: GithubAuth -> String -- ^ owner -> String -- ^ repository name -> IO (Either Error ()) deleteRepo auth owner repo = do result <- doHttps "DELETE" url (Just auth) Nothing 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 ()) where url = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo