Can now log in to github, to avoid increasingly small API rate limits.

Set GITHUB_USER and GITHUB_PASSWORD environment to enable.

Note that noAuth is used for a few functions, due to the github haskell
library not yet providing authed versions of those.

4 files changed, 61 insertions, 26 deletions

diff --git a/README.md b/README.md
index efb63ea..bd840c3 100644
--- a/README.md
+++ b/README.md
@@ -88,9 +88,13 @@ or even if it just has a lot of forks.
 
 Bear in mind that this uses the GitHub API; don't run it every 5 minutes.
 GitHub [rate limits](http://developer.github.com/v3/#rate-limiting) the
-API to some small number of requests per hour. However, github-backup
-*does* do an incremental backup, picking up where it left off, so will
-complete the backup eventually even if it's rate limited.
+API to some small number of requests per hour when used without
+authentication. To avoid this limit, you can set `GITHUB_USER` and
+`GITHUB_PASSWORD` in the environment and it will log in when making 
+(most) API requests.
+
+Anyway, github-backup *does* do an incremental backup, picking up where it
+left off, so will complete the backup eventually even if it's rate limited.
 
 ## Author
 
diff --git a/debian/changelog b/debian/changelog
index ace4265..a1df26d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,8 @@ github-backup (1.20131007) UNRELEASED; urgency=low
   * Now also backs up the repos a user is watching, when run with a user's
     name. Useful if you want to back up repositories that you have not forked;
     just watch them and run github-backup.
+  * Can now log in to github, to avoid increasingly small API rate limits.
+    Set GITHUB_USER and GITHUB_PASSWORD environment to enable.
   * Build-Depend on git. Closes: #728481
   * Don't include tmp directory in files stored in the github branch.
 
diff --git a/github-backup.1 b/github-backup.1
index 95ed3f4..4560baf 100644
--- a/github-backup.1
+++ b/github-backup.1
@@ -15,5 +15,10 @@ Alternately, if you pass it the username of a GitHub user, it will check
 out, and back up, all that user's repositories, as well as all the
 repositories that user is watching. (Also works to pass
 the name of an organization using GitHub.)
+.PP
+By default it runs without logging in to GitHub. To log in, set
+GITHUB_USER and GITHUB_PASSWORD environment variables. However note that
+this only works around API rate limiting, it does not allow private
+repositories to be downloaded.
 .SH AUTHOR 
 Joey Hess <joey@kitenet.net>
diff --git a/github-backup.hs b/github-backup.hs
index 8b5fde1..9f0ba56 100644
--- a/github-backup.hs
+++ b/github-backup.hs
@@ -1,6 +1,6 @@
 {- github-backup
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -12,9 +12,11 @@ module Main where
 
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Data.Either
 import Data.Monoid
-import System.Environment
+import System.Environment (getArgs)
 import Control.Exception (try, SomeException)
 import Text.Show.Pretty
 import "mtl" Control.Monad.State.Strict
@@ -40,6 +42,7 @@ import qualified Git.Branch
 import qualified Git.UpdateIndex
 import Git.HashObject
 import Git.FilePath
+import Utility.Env
 
 -- A github user and repo.
 data GithubUserRepo = GithubUserRepo String String
@@ -78,6 +81,7 @@ data BackupState = BackupState
 	{ failedRequests :: S.Set Request
 	, retriedRequests :: S.Set Request
 	, gitRepo :: Git.Repo
+	, gitHubAuth :: Maybe Github.GithubAuth
 	}
 
 {- Our monad. -}
@@ -139,36 +143,37 @@ lookupApi req = fromMaybe bad $ M.lookup name api
 	bad = error $ "internal error: bad api call: " ++ name
 
 userrepoStore :: Storer
-userrepoStore = simpleHelper Github.userRepo $ \req r -> do
+userrepoStore = simpleHelper (noAuth Github.userRepo) $ \req r -> do
 	when (Github.repoHasWiki r == Just True) $
 		updateWiki $ toGithubUserRepo r
 	store "repo" req r
 
 watchersStore :: Storer
-watchersStore = simpleHelper Github.watchersFor $ storeSorted "watchers"
+watchersStore = simpleHelper (noAuth Github.watchersFor) $
+	storeSorted "watchers"
 
 pullrequestsStore :: Storer
-pullrequestsStore = simpleHelper Github.pullRequestsFor $
+pullrequestsStore = simpleHelper Github.pullRequestsFor' $
 	forValues $ \req r -> do
 		let repo = requestRepo req
 		let n = Github.pullRequestNumber r
 		runRequest $ RequestNum "pullrequest" repo n
 
 pullrequestStore :: Storer
-pullrequestStore = numHelper Github.pullRequest $ \n ->
+pullrequestStore = numHelper Github.pullRequest' $ \n ->
 	store ("pullrequest" </> show n)
 
 milestonesStore :: Storer
-milestonesStore = simpleHelper Github.Issues.Milestones.milestones $
+milestonesStore = simpleHelper Github.Issues.Milestones.milestones' $
 	forValues $ \req m -> do
 		let n = Github.milestoneNumber m
 		store ("milestone" </> show n) req m
 
 issuesStore :: Storer
-issuesStore = withHelper (\u r y ->
-	Github.issuesForRepo u r (y <> [Github.Open])
+issuesStore = withHelper (\a u r y ->
+	Github.issuesForRepo' a u r (y <> [Github.Open])
 		>>= either (return . Left)
-			(\xs -> Github.issuesForRepo u r
+			(\xs -> Github.issuesForRepo' a u r
 				(y <> [Github.OnlyClosed])
 					>>= either (return . Left)
 						(\ys -> return (Right (xs <> ys)))))
@@ -181,13 +186,13 @@ issuesStore = withHelper (\u r y ->
 		runRequest (RequestNum "issuecomments" repo n)
 
 issuecommentsStore :: Storer
-issuecommentsStore = numHelper Github.Issues.Comments.comments $ \n ->
+issuecommentsStore = numHelper Github.Issues.Comments.comments' $ \n ->
 	forValues $ \req c -> do
 		let i = Github.issueCommentId c
 		store ("issue" </> show n ++ "_comment" </> show i) req c
 
 forksStore :: Storer
-forksStore = simpleHelper Github.forksFor $ \req fs -> do
+forksStore = simpleHelper (noAuth Github.forksFor) $ \req fs -> do
 	storeSorted "forks" req fs
 	mapM_ (traverse . toGithubUserRepo) fs
   where
@@ -197,25 +202,31 @@ forksStore = simpleHelper Github.forksFor $ \req fs -> do
 forValues :: (Request -> v -> Backup ()) -> Request -> [v] -> Backup ()
 forValues handle req vs = forM_ vs (handle req)
 
-type ApiCall v = String -> String -> IO (Either Github.Error v)
-type ApiWith v b = String -> String -> b -> IO (Either Github.Error v)
+type ApiCall v = Maybe Github.GithubAuth -> String -> String -> IO (Either Github.Error v)
+type ApiWith v b = Maybe Github.GithubAuth -> String -> String -> b -> IO (Either Github.Error v)
 type ApiNum v = ApiWith v Int
 type Handler v = Request -> v -> Backup ()
 type Helper = Request -> Backup ()
 
+noAuth :: (String -> String -> IO a) -> Maybe Github.GithubAuth -> String -> String -> IO a
+noAuth a _auth user repo = a user repo
+
 simpleHelper :: ApiCall v -> Handler v -> Helper
-simpleHelper call handle req@(RequestSimple _ (GithubUserRepo user repo)) =
-	either (failedRequest req) (handle req) =<< liftIO (call user repo)
+simpleHelper call handle req@(RequestSimple _ (GithubUserRepo user repo)) = do
+	auth <- getState gitHubAuth
+	either (failedRequest req) (handle req) =<< liftIO (call auth user repo)
 simpleHelper _ _ r = badRequest r
 
 withHelper :: ApiWith v b -> b -> Handler v -> Helper
-withHelper call b handle req@(RequestSimple _ (GithubUserRepo user repo)) =
-	either (failedRequest req) (handle req) =<< liftIO (call user repo b)
+withHelper call b handle req@(RequestSimple _ (GithubUserRepo user repo)) = do
+	auth <- getState gitHubAuth
+	either (failedRequest req) (handle req) =<< liftIO (call auth user repo b)
 withHelper _ _ _ r = badRequest r
 
 numHelper :: ApiNum v -> (Int -> Handler v) -> Helper
-numHelper call handle req@(RequestNum _ (GithubUserRepo user repo) num) =
-	either (failedRequest req) (handle num req) =<< liftIO (call user repo num)
+numHelper call handle req@(RequestNum _ (GithubUserRepo user repo) num) = do
+	auth <- getState gitHubAuth
+	either (failedRequest req) (handle num req) =<< liftIO (call auth user repo num)
 numHelper _ _ r = badRequest r
 
 badRequest :: Request -> a
@@ -464,12 +475,25 @@ save retriedfailed = do
 			[ "Run again later."
 			]
 
-newState :: Git.Repo -> BackupState
-newState = BackupState S.empty S.empty
+newState :: Git.Repo -> IO BackupState
+newState r = BackupState
+	<$> pure S.empty
+	<*> pure S.empty
+	<*> pure r
+	<*> getauth
+  where
+	getauth = do
+		user <- getEnv "GITHUB_USER"
+		password <- getEnv "GITHUB_PASSWORD"
+		return $ case (user, password) of
+			(Just u, Just p) -> Just $ 
+				Github.GithubBasicAuth (tobs u) (tobs p)
+			_ -> Nothing
+	tobs = encodeUtf8 . T.pack
 
 backupRepo :: (Maybe Git.Repo) -> IO ()
 backupRepo Nothing = error "not in a git repository, and nothing specified to back up"
-backupRepo (Just repo) = evalStateT (runBackup go) . newState =<< Git.Config.read repo
+backupRepo (Just repo) = evalStateT (runBackup go) =<< newState =<< Git.Config.read repo
   where
 	go = do
 		retriedfailed <- retry