github 0.4.1 → 0.5.0

raw patch · 9 files changed

+78/−61 lines, 9 filesdep +case-insensitivedep ~attoparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: case-insensitive

Dependency ranges changed: attoparsec

API changes (from Hackage documentation)

Files

• Github/Gists.hs +2/−2
• Github/Issues.hs +2/−2
• Github/Organizations.hs +2/−2
• Github/Private.hs +24/−12
• Github/PullRequests.hs +4/−4
• Github/Repos.hs +38/−34
• Github/Users.hs +1/−1
• README.md +1/−1
• github.cabal +4/−3

@@ -13,7 +13,7 @@ -- | The list of all gists created by the user  --  -- > gists' (Just ("github-username", "github-password")) "mike-burns"-gists' :: Maybe BasicAuth -> String -> IO (Either Error [Gist])+gists' :: Maybe GithubAuth -> String -> IO (Either Error [Gist]) gists' auth userName = githubGet' auth ["users", userName, "gists"]  -- | The list of all public gists created by the user.@@ -25,7 +25,7 @@ -- | A specific gist, given its id, with authentication credentials -- -- > gist' (Just ("github-username", "github-password")) "225074"-gist' :: Maybe BasicAuth -> String -> IO (Either Error Gist)+gist' :: Maybe GithubAuth -> String -> IO (Either Error Gist) gist' auth gistId = githubGet' auth ["gists", gistId]  -- | A specific gist, given its id.

@@ -37,7 +37,7 @@ -- number.' -- -- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462"-issue' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error Issue)+issue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error Issue) issue' auth user repoName issueNumber =   githubGet' auth ["repos", user, repoName, "issues", show issueNumber] @@ -52,7 +52,7 @@ -- restrictions as described in the @IssueLimitation@ data type. -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending]-issuesForRepo' :: Maybe BasicAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue])+issuesForRepo' :: Maybe GithubAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue]) issuesForRepo' auth user repoName issueLimitations =   githubGetWithQueryString'      auth

@@ -13,7 +13,7 @@ -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns"-publicOrganizationsFor' :: Maybe BasicAuth -> String -> IO (Either Error [SimpleOrganization])+publicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization]) publicOrganizationsFor' auth userName = githubGet' auth ["users", userName, "orgs"]  -- | The public organizations for a user, given the user's login.@@ -25,7 +25,7 @@ -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot"-publicOrganization' :: Maybe BasicAuth -> String -> IO (Either Error Organization)+publicOrganization' :: Maybe GithubAuth -> String -> IO (Either Error Organization) publicOrganization' auth organizationName = githubGet' auth ["orgs", organizationName]  -- | Details on a public organization. Takes the organization's login.

@@ -1,11 +1,13 @@-{-# LANGUAGE OverloadedStrings, StandaloneDeriving #-}+{-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-} module Github.Private where  import Github.Data import Data.Aeson import Data.Attoparsec.ByteString.Lazy+import Data.Data import Control.Applicative import Data.List+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(..))@@ -14,10 +16,15 @@ import qualified Control.Exception as E import Data.Maybe (fromMaybe) +-- | user/password for HTTP basic access authentication+data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString+                | GithubOAuth String+                deriving (Show, Data, Typeable, Eq, Ord)+ githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) githubGet = githubGet' Nothing -githubGet' :: (FromJSON b, Show b) => Maybe BasicAuth -> [String] -> IO (Either Error b)+githubGet' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> IO (Either Error b) githubGet' auth paths =   githubAPI (BS.pack "GET")             (buildUrl paths)@@ -27,21 +34,21 @@ githubGetWithQueryString :: (FromJSON b, Show b) => [String] -> String -> IO (Either Error b) githubGetWithQueryString = githubGetWithQueryString' Nothing -githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe BasicAuth -> [String] -> String -> IO (Either Error b)+githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b) githubGetWithQueryString' auth paths queryString =   githubAPI (BS.pack "GET")             (buildUrl paths ++ "?" ++ queryString)             auth             (Nothing :: Maybe Value) -githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => BasicAuth -> [String] -> a -> IO (Either Error b)+githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) githubPost auth paths body =   githubAPI (BS.pack "POST")             (buildUrl paths)             (Just auth)             (Just body) -githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => BasicAuth -> [String] -> a -> IO (Either Error b)+githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) githubPatch auth paths body =   githubAPI (BS.pack "PATCH")             (buildUrl paths)@@ -51,7 +58,7 @@ buildUrl :: [String] -> String buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths -githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe BasicAuth -> Maybe a -> IO (Either Error b)+githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) githubAPI method url auth body = do   result <- doHttps method url auth (Just encodedBody)   return $ either (Left . HTTPConnectionError)@@ -59,20 +66,19 @@                   result   where encodedBody = RequestBodyLBS $ encode $ toJSON body --- | user/password for HTTP basic access authentication-type BasicAuth = (BS.ByteString, BS.ByteString)--doHttps :: Method -> String -> Maybe BasicAuth -> Maybe (RequestBody (ResourceT IO)) -> IO (Either E.SomeException (Response LBS.ByteString))+doHttps :: Method -> String -> Maybe GithubAuth -> Maybe (RequestBody (ResourceT IO)) -> IO (Either E.SomeException (Response LBS.ByteString)) doHttps method url auth body = do   let requestBody = fromMaybe (RequestBodyBS $ BS.pack "") body+      requestHeaders = maybe [] getOAuth auth       (Just uri) = parseUrl url       request = uri { method = method                     , secure = True                     , port = 443                     , requestBody = requestBody+                    , requestHeaders = requestHeaders                     , checkStatus = successOrMissing                     }-      authRequest = maybe id (uncurry applyBasicAuth) auth request+      authRequest = getAuthRequest auth request    (getResponse authRequest >>= return . Right) `E.catches` [       -- Re-throw AsyncException, otherwise execution will not terminate on@@ -80,10 +86,16 @@       -- UserInterrupt) because all of them indicate severe conditions and       -- should not occur during normal operation.       E.Handler (\e -> E.throw (e :: E.AsyncException)),-         E.Handler (\e -> (return . Left) (e :: E.SomeException))       ]   where+    getAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass+    getAuthRequest _ = id+    getBasicAuth (GithubBasicAuth user pass) = applyBasicAuth user pass+    getBasicAuth _ = id+    getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"),+                                     BS.pack ("token " ++ token))]+    getOAuth _ = []     getResponse request = withManager $ \manager -> httpLbs request manager     successOrMissing s@(Status sci _) hs       | (200 <= sci && sci < 300) || sci == 404 = Nothing

@@ -19,7 +19,7 @@ -- | With authentification -- -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails"-pullRequestsFor' :: Maybe BasicAuth -> String -> String -> IO (Either Error [PullRequest])+pullRequestsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [PullRequest]) pullRequestsFor' auth userName repoName =   githubGet' auth ["repos", userName, repoName, "pulls"] @@ -34,7 +34,7 @@ -- | With authentification -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562-pullRequest' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest)+pullRequest' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest) pullRequest' auth userName repoName number =   githubGet' auth ["repos", userName, repoName, "pulls", show number] @@ -50,7 +50,7 @@ -- | With authentification -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688-pullRequestCommits' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error [Commit])+pullRequestCommits' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Commit]) pullRequestCommits' auth userName repoName number =   githubGet' auth ["repos", userName, repoName, "pulls", show number, "commits"] @@ -66,7 +66,7 @@ -- | With authentification -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688-pullRequestFiles' :: Maybe BasicAuth -> String -> String -> Int -> IO (Either Error [File])+pullRequestFiles' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [File]) pullRequestFiles' auth userName repoName number =   githubGet' auth ["repos", userName, repoName, "pulls", show number, "files"] -- | The individual files that a pull request patches. Takes the repo owner and

@@ -5,8 +5,9 @@  -- * Querying repositories  userRepos-,organizationRepos ,userRepo+,organizationRepos+,organizationRepo ,contributors ,contributorsWithAnonymous ,languagesFor@@ -17,9 +18,8 @@  -- * Modifying repositories -- |--- Only authenticated users may modify repositories.  Currently only--- /HTTP basic access authentication/ is implemented.-,BasicAuth+-- Only authenticated users may modify repositories.+,GithubAuth(..)  -- ** Create ,createRepo@@ -43,6 +43,7 @@ import Network.HTTP.Conduit import qualified Data.ByteString.Char8 as BS 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.@@ -77,6 +78,12 @@ organizationRepos :: String -> IO (Either Error [Repo]) organizationRepos orgName = githubGet ["orgs", orgName, "repos"] +-- | A specific organization repo, by the organization name.+--+-- > organizationRepo "thoughtbot" "github"+organizationRepo :: String -> String -> IO (Either Error Repo)+organizationRepo orgName repoName = githubGet ["orgs", orgName, repoName]+ -- | Details on a specific repo, given the owner and repo name. -- -- > userRepo "mike-burns" "github"@@ -133,6 +140,7 @@ , newRepoHasIssues    :: (Maybe Bool) , newRepoHasWiki      :: (Maybe Bool) , newRepoHasDownloads :: (Maybe Bool)+, newRepoAutoInit     :: (Maybe Bool) } deriving Show  instance ToJSON  NewRepo where@@ -143,6 +151,7 @@                   , newRepoHasIssues    = hasIssues                   , newRepoHasWiki      = hasWiki                   , newRepoHasDownloads = hasDownloads+                  , newRepoAutoInit     = autoInit                   }) = object                   [ "name"                .= name                   , "description"         .= description@@ -150,24 +159,24 @@                   , "private"             .= private                   , "has_issues"          .= hasIssues                   , "has_wiki"            .= hasWiki-                  , "has_downloads"       .= hasDownloads+                  , "auto_init"           .= autoInit                   ]  newRepo :: String -> NewRepo-newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing+newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing Nothing  -- | -- Create a new repository. ----- > createRepo (user, password) (newRepo "some_repo") {newRepoHasIssues = Just False}-createRepo :: BasicAuth -> NewRepo -> IO (Either Error Repo)+-- > createRepo (GithubUser (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 (user, password) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False}-createOrganizationRepo :: BasicAuth -> String -> NewRepo -> IO (Either Error Repo)+-- > createOrganizationRepo (GithubUser (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 {@@ -204,8 +213,8 @@ -- | -- Edit an existing repository. ----- > editRepo (user, password) "some_user" "some_repo" def {editDescription = Just "some description"}-editRepo :: BasicAuth+-- > editRepo (GithubUser (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"}+editRepo :: GithubAuth      -> String      -- ^ owner      -> String      -- ^ repository name      -> Edit@@ -218,30 +227,25 @@ -- | -- Delete an existing repository. ----- > deleteRepo (user, password) "thoughtbot" "some_repo"-deleteRepo :: BasicAuth+-- > deleteRepo (GithubUser (user, password)) "thoughtbot" "some_repo"+deleteRepo :: GithubAuth            -> String      -- ^ owner            -> String      -- ^ repository name            -> IO (Either Error ()) deleteRepo auth owner repo = do-  requestToken >>= either (return . Left) (sendToken)+  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))))+             else return (Right ())   where-    -- APIv3 does not support deletion, so we use APIv2 for that-    url = "https://github.com/api/v2/json/repos/delete/" ++ owner ++ "/" ++ repo--    requestToken :: IO (Either Error DeleteToken)-    requestToken = githubAPI "POST" url (Just auth) (Nothing :: Maybe Value)--    sendToken (DeleteToken t) = do-      let body = RequestBodyBS $ renderSimpleQuery False [("delete_token", t)]-      result <- doHttps "POST" url (Just auth) (Just body)-      return $ either (Left . HTTPConnectionError)-                      (const $ Right ())-                      result--newtype DeleteToken = DeleteToken BS.ByteString-  deriving Show--instance FromJSON DeleteToken where-  parseJSON (Object o) = DeleteToken <$> o .: "delete_token"-  parseJSON _          = fail "Could not build a DeleteToken"+    url = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo

@@ -13,7 +13,7 @@ -- | With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns"-userInfoFor' :: Maybe BasicAuth -> String -> IO (Either Error DetailedOwner)+userInfoFor' :: Maybe GithubAuth -> String -> IO (Either Error DetailedOwner) userInfoFor' auth userName = githubGet' auth ["users", userName]  -- | The information for a single user, by login name.

@@ -27,7 +27,7 @@ Documentation ============= -For details see the reference documentation on Hackage. Later.+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/). 

@@ -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.4.1+Version:             0.5.0  -- A short (one-line) description of the package. Synopsis:            Access to the Github API, v3.@@ -36,7 +36,7 @@ Homepage:            https://github.com/mike-burns/github  -- A copyright notice.-Copyright:           Copyright 2012 Mike Burns+Copyright:           Copyright 2012-2013 Mike Burns  Category:            Network APIs @@ -141,8 +141,9 @@   Build-depends: base >= 4.0 && < 5.0,                  time,                  aeson == 0.6.1.0,-                 attoparsec == 0.10.3.0,+                 attoparsec >= 0.10.3.0,                  bytestring,+                 case-insensitive >= 0.4.0.4,                  containers,                  text,                  old-locale,