github-backup 1.20160207 → 1.20160319

raw patch · 16 files changed

+240/−103 lines, 16 filesdep +vectordep ~github

Dependencies added: vector

Dependency ranges changed: github

Files

• 56.patch +69/−0
• CHANGELOG +9/−0
• Github/Data/Readable.hs +0/−14
• Github/EnumRepos.hs +9/−5
• Github/GetAuth.hs +18/−15
• README.md +8/−2
• debian/changelog +9/−0
• debian/control +4/−2
• github-backup.1 +4/−3
• github-backup.cabal +9/−9
• github-backup.hs +51/−39
• github-backup.tmp/Administr8Me_github-backup/stargazers +1/−0
• github-backup.tmp/Administr8Me_github-backup/watchers +1/−0
• gitriddance.1 +1/−0
• gitriddance.hs +12/−14
• stack.yaml +35/−0

@@ -0,0 +1,69 @@+From c069ea587e52c435b4903271f3f9e287e9afe4a4 Mon Sep 17 00:00:00 2001+From: Diogo Biazus <diogob@gmail.com>+Date: Thu, 11 Feb 2016 10:37:03 -0500+Subject: [PATCH] Adds stack.yml and section about how to build using it to+ README.++---+ README.md  |  5 ++++++ stack.yaml | 35 ++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+)+ create mode 100644 stack.yaml++diff --git a/README.md b/README.md+index 0ec8444..a144e51 100644+--- a/README.md++++ b/README.md+@@ -82,6 +82,11 @@ 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.+ ++## Contributing++++Besides the cabal instalation you can also use [stack](https://www.stackage.org) to build from sources.++Once you have stack installed just type ```stack build``` in the repo root directory.+++ ## Author+ + github-backup was written by Joey Hess <joey@kitenet.net>+diff --git a/stack.yaml b/stack.yaml+new file mode 100644+index 0000000..80a6239+--- /dev/null++++ b/stack.yaml+@@ -0,0 +1,35 @@++# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html++++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)++resolver: lts-5.2++++# Local packages, usually specified by relative directory name++packages:++- '.'++++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)++extra-deps: []++++# Override default flag values for local packages and extra-deps++flags: {}++++# Extra package databases containing global packages++extra-package-dbs: []++++# Control whether we use the GHC we find on the path++# system-ghc: true++++# Require a specific version of stack, using version ranges++# require-stack-version: -any # Default++# require-stack-version: >= 1.0.0++++# Override the architecture used by stack, especially useful on Windows++# arch: i386++# arch: x86_64++++# Extra directories used by stack for building++# extra-include-dirs: [/path/to/dir]++# extra-lib-dirs: [/path/to/dir]++++# Allow a newer minor version of GHC than the snapshot specifies++# compiler-check: newer-minor

@@ -1,3 +1,12 @@+github-backup (1.20160319) unstable; urgency=medium++  * Update to github-0.14.1.+    Building with old versions is not supported due to the massive API+    changes in this version of the github library.+  * Added support for oath tokens.++ -- Joey Hess <id@joeyh.name>  Sat, 19 Mar 2016 14:11:55 -0400+ github-backup (1.20160207) unstable; urgency=medium    * Switch to using https instead of git:// for a secure transport.

@@ -1,14 +0,0 @@-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- | This module re-exports the @Github.Data.Definitions@ module, adding--- instances of @Read@ to it.--module Github.Data.Readable (module Github.Data.Definitions) where--import Github.Data.Definitions--deriving instance Read GithubDate-deriving instance Read GithubOwner-deriving instance Read Repo-deriving instance Read RepoRef

@@ -1,9 +1,12 @@ module Github.EnumRepos where -import qualified Github.Repos as Github+import qualified GitHub.Data.Repos as Github+import qualified GitHub.Data.Definitions as Github+import qualified GitHub.Data.Name as Github import Data.List import Data.List.Utils import Data.Maybe+import qualified Data.Text as T  import Utility.PartialPrelude import qualified Git@@ -18,12 +21,13 @@  instance ToGithubUserRepo Github.Repo where 	toGithubUserRepo r = GithubUserRepo -		(Github.githubOwnerLogin $ Github.repoOwner r)-		(Github.repoName r)+		(T.unpack $ Github.untagName $ Github.simpleOwnerLogin $ Github.repoOwner r)+		(T.unpack $ Github.untagName $ Github.repoName r)  instance ToGithubUserRepo Github.RepoRef where-	toGithubUserRepo (Github.RepoRef owner name) = -		GithubUserRepo (Github.githubOwnerLogin owner) name+	toGithubUserRepo (Github.RepoRef owner name) = GithubUserRepo+		(T.unpack $ Github.untagName $ Github.simpleOwnerLogin owner)+		(T.unpack $ Github.untagName name)  gitHubRepos :: Git.Repo -> [Git.Repo] gitHubRepos = fst . unzip . gitHubPairs

@@ -1,24 +1,27 @@-{-# LANGUAGE CPP #-}- module Github.GetAuth where  import Utility.Env+import Utility.Monad -#if MIN_VERSION_github(0,9,0)-import qualified Github.Auth as Github-#else-import qualified Github.Issues as Github-#endif+import qualified GitHub.Auth as Github import Data.Text.Encoding (encodeUtf8) import qualified Data.Text as T+import qualified Data.ByteString.UTF8 as B -getAuth :: IO (Maybe Github.GithubAuth)-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+getAuth :: IO (Maybe Github.Auth)+getAuth = getM id+	[ do+		user <- getEnv "GITHUB_USER"+		password <- getEnv "GITHUB_PASSWORD"+		return $ case (user, password) of+			(Just u, Just p) -> Just $ +				Github.BasicAuth (tobs u) (tobs p)+			_ -> Nothing+	, do+		oauthtoken <- getEnv "GITHUB_OAUTH_TOKEN"+		return $ case oauthtoken of+			Just t -> Just $ Github.OAuth (B.fromString t)+			Nothing -> Nothing+	]   where 	tobs = encodeUtf8 . T.pack

@@ -75,11 +75,17 @@ GitHub [rate limits](http://developer.github.com/v3/#rate-limiting) the 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.+`GITHUB_PASSWORD` (or `GITHUB_OAUTH_TOKEN` obtained from+<https://github.com/settings/tokens>) 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.++## Contributing++Besides the cabal instalation you can also use [stack](https://www.stackage.org) to build from sources.+Once you have stack installed just type ```stack build``` in the repo root directory.  ## Author 

@@ -1,3 +1,12 @@+github-backup (1.20160319) unstable; urgency=medium++  * Update to github-0.14.1.+    Building with old versions is not supported due to the massive API+    changes in this version of the github library.+  * Added support for oath tokens.++ -- Joey Hess <id@joeyh.name>  Sat, 19 Mar 2016 14:11:55 -0400+ github-backup (1.20160207) unstable; urgency=medium    * Switch to using https instead of git:// for a secure transport.

@@ -5,7 +5,7 @@ 	debhelper (>= 9), 	ghc, 	git,-	libghc-github-dev (>= 0.13.1),+	libghc-github-dev (>= 0.14.0), libghc-github-dev (<< 0.15.0), 	libghc-missingh-dev, 	libghc-hslogger-dev, 	libghc-pretty-show-dev,@@ -13,7 +13,9 @@ 	libghc-exceptions-dev, 	libghc-transformers-dev, 	libghc-unix-compat-dev,-	libghc-optparse-applicative-dev+	libghc-optparse-applicative-dev,+	libghc-vector-dev,+	libghc-utf8-string-dev, Maintainer: James McCoy <jamessan@debian.org> Standards-Version: 3.9.5 Vcs-Git: git://github.com/joeyh/github-backup.git

@@ -17,9 +17,10 @@ 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.+the GITHUB_USER and GITHUB_PASSWORD environment variables. Or, set+GITHUB_OAUTH_TOKEN to an oath or personal access token.+However note that logging in only works around API rate limiting; it+does not allow private repositories to be downloaded. .SH OPTIONS .PP .IP --exclude=username/repository

@@ -1,5 +1,5 @@ Name: github-backup-Version: 1.20160207+Version: 1.20160319 Cabal-Version: >= 1.8 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess@@ -28,15 +28,15 @@   Main-Is: github-backup.hs   GHC-Options: -Wall -fno-warn-tabs   Build-Depends: MissingH, hslogger, directory, filepath, containers, mtl,-   network, exceptions, transformers, unix-compat, bytestring,-   IfElse, pretty-show, text, process, optparse-applicative,-   github >= 0.7.2 && < 0.14.0,+   network, exceptions, transformers, unix-compat, bytestring, vector,+   IfElse, pretty-show, text, process, optparse-applicative, utf8-string,+   github >= 0.14.0 && < 0.15.0,    base >= 4.5, base < 5      if (! os(windows))     Build-Depends: unix   else-    Build-Depends: Win32, setenv, utf8-string+    Build-Depends: Win32, setenv      if flag(network-uri)     Build-Depends: network-uri (>= 2.6), network (>= 2.6)@@ -46,14 +46,14 @@ Executable gitriddance   Main-Is: gitriddance.hs   GHC-Options: -Wall -fno-warn-tabs-  Build-Depends: github >= 0.13.1 && < 0.14.0, base >= 4.5, base < 5, text, filepath,-    MissingH, exceptions, transformers, bytestring, hslogger, process,-    containers, unix-compat, IfElse, directory, mtl+  Build-Depends: github >= 0.14.0 && < 0.15.0, base >= 4.5, base < 5, text, filepath,+    MissingH, exceptions, transformers, bytestring, vector, hslogger, process,+    containers, unix-compat, IfElse, directory, mtl, utf8-string      if (! os(windows))     Build-Depends: unix   else-    Build-Depends: Win32, setenv, utf8-string+    Build-Depends: Win32, setenv      if flag(network-uri)     Build-Depends: network-uri (>= 2.6), network (>= 2.6)

@@ -5,7 +5,6 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PackageImports #-} @@ -13,23 +12,28 @@  import qualified Data.Map as M import qualified Data.Set as S+import qualified Data.Text as T import Data.Either import Data.Monoid+import Data.String+import GHC.Exts (toList)+import Data.Vector (Vector) import Options.Applicative import Text.Show.Pretty import "mtl" Control.Monad.State.Strict-import qualified Github.Repos as Github-#if MIN_VERSION_github(0,9,0)-import qualified Github.Auth as Github-#endif-import qualified Github.Repos.Forks as Github-import qualified Github.PullRequests as Github-import qualified Github.Repos.Watching as Github-import qualified Github.Repos.Starring as Github-import qualified Github.Data.Definitions as Github ()-import qualified Github.Issues as Github-import qualified Github.Issues.Comments-import qualified Github.Issues.Milestones+import qualified GitHub.Data.Id as Github+import qualified GitHub.Data.Name as Github+import qualified GitHub.Auth as Github+import qualified GitHub.Data.Repos as Github+import qualified GitHub.Endpoints.Repos as Github+import qualified GitHub.Endpoints.Repos.Forks as Github+import qualified GitHub.Endpoints.PullRequests as Github+import qualified GitHub.Endpoints.Activity.Watching as Github+import qualified GitHub.Endpoints.Activity.Starring as Github+import qualified GitHub.Data.Definitions as Github ()+import qualified GitHub.Endpoints.Issues as Github+import qualified GitHub.Endpoints.Issues.Comments+import qualified GitHub.Endpoints.Issues.Milestones  import Common import Utility.State@@ -77,7 +81,7 @@ 	, retriedRequests :: S.Set Request 	, retriedFailed :: S.Set Request 	, gitRepo :: Git.Repo-	, gitHubAuth :: Maybe Github.GithubAuth+	, gitHubAuth :: Maybe Github.Auth 	, deferredBackups :: [Backup ()] 	, catFileHandle :: Maybe CatFileHandle 	, noForks :: Bool@@ -154,24 +158,29 @@ pullrequestsStore = simpleHelper "pullrequest" Github.pullRequestsFor' $ 	forValues $ \req r -> do 		let repo = requestRepo req-		let n = Github.pullRequestNumber r+		let n = Github.simplePullRequestNumber r 		runRequest $ RequestNum "pullrequest" repo n  pullrequestStore :: Storer-pullrequestStore = numHelper "pullrequest" Github.pullRequest' $ \n ->+pullrequestStore = numHelper "pullrequest" call $ \n -> 	store ("pullrequest" </> show n)+  where+	call auth user repo n = Github.pullRequest' auth+		(fromString user)+		(fromString repo)+		(Github.mkId (Github.Id 0) n)  milestonesStore :: Storer-milestonesStore = simpleHelper "milestone" Github.Issues.Milestones.milestones' $+milestonesStore = simpleHelper "milestone" GitHub.Endpoints.Issues.Milestones.milestones' $ 	forValues $ \req m -> do 		let n = Github.milestoneNumber m 		store ("milestone" </> show n) req m  issuesStore :: Storer issuesStore = withHelper "issue" (\a u r y ->-	Github.issuesForRepo' a u r (y <> [Github.Open])+	Github.issuesForRepo' a (fromString u) (fromString r) (y <> [Github.Open]) 		>>= either (return . Left)-			(\xs -> Github.issuesForRepo' a u r+			(\xs -> Github.issuesForRepo' a (fromString u) (fromString r) 				(y <> [Github.OnlyClosed]) 					>>= either (return . Left) 						(\ys -> return (Right (xs <> ys)))))@@ -184,13 +193,18 @@ 		runRequest (RequestNum "issuecomments" repo n)  issuecommentsStore :: Storer-issuecommentsStore = numHelper "issuecomments" Github.Issues.Comments.comments' $ \n ->+issuecommentsStore = numHelper "issuecomments" call $ \n -> 	forValues $ \req c -> do 		let i = Github.issueCommentId c 		store ("issue" </> show n ++ "_comment" </> show i) req c+  where+	call auth user repo n = GitHub.Endpoints.Issues.Comments.comments' auth+		(fromString user)+		(fromString repo)+		(Github.mkId (Github.Id 0) n)  userrepoStore :: Storer-userrepoStore = simpleHelper "repo" Github.userRepo' $ \req r -> do+userrepoStore = simpleHelper "repo" Github.repository' $ \req r -> do 	store "repo" req r 	when (Github.repoHasWiki r == Just True) $ 		updateWiki $ toGithubUserRepo r@@ -202,11 +216,11 @@ 	storeSorted "forks" req fs 	mapM_ addFork fs -forValues :: (Request -> v -> Backup ()) -> Request -> [v] -> Backup ()-forValues a req vs = forM_ vs (a req)+forValues :: (Request -> v -> Backup ()) -> Request -> Vector v -> Backup ()+forValues a req vs = forM_ (toList vs) (a req) -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 ApiCall v = Maybe Github.Auth -> Github.Name Github.Owner -> Github.Name Github.Repo -> IO (Either Github.Error v)+type ApiWith v b = Maybe Github.Auth -> String -> String -> b -> IO (Either Github.Error v) type ApiNum v = ApiWith v Int type Handler v = Request -> v -> Backup () type Helper = Request -> Backup ()@@ -215,7 +229,8 @@ simpleHelper dest call handler req@(RequestSimple _ (GithubUserRepo user repo)) = 	deferOn dest req $ do 		auth <- getState gitHubAuth-		either (failedRequest req) (handler req) =<< liftIO (call auth user repo)+		either (failedRequest req) (handler req)+			=<< liftIO (call auth (fromString user) (fromString repo)) simpleHelper _ _ _ r = badRequest r  withHelper :: FilePath -> ApiWith v b -> b -> Handler v -> Helper@@ -229,7 +244,8 @@ numHelper dest call handler req@(RequestNum _ (GithubUserRepo user repo) num) = 	deferOn dest req $ do 		auth <- getState gitHubAuth-		either (failedRequest req) (handler num req) =<< liftIO (call auth user repo num)+		either (failedRequest req) (handler num req)+			=<< liftIO (call auth user repo num) numHelper _ _ _ r = badRequest r  badRequest :: Request -> a@@ -277,8 +293,8 @@ 		<$> (Git.repoPath <$> getState gitRepo) 		<*> pure "github-backup.tmp" -storeSorted :: Ord a => Show a => FilePath -> Request -> [a] -> Backup ()-storeSorted file req val = store file req (sort val)+storeSorted :: Ord a => Show a => FilePath -> Request -> Vector a -> Backup ()+storeSorted file req val = store file req (sort $ toList val)  {- Commits all files in the workDir into the github branch, and deletes the  - workDir.@@ -527,12 +543,12 @@ backupOwner noforks exclude (Owner name) = do 	auth <- getAuth 	l <- sequence-	 	[ Github.userRepos' auth name Github.All-		, Github.reposWatchedBy' auth name-		, Github.reposStarredBy auth name-		, Github.organizationRepos' auth name+	 	[ Github.userRepos' auth (fromString name) Github.RepoPublicityAll+		, Github.reposWatchedBy' auth (fromString name)+		, Github.reposStarredBy auth (fromString name)+		, Github.organizationRepos' auth (fromString name) Github.RepoPublicityAll 		]-	let nameurls = nub $ mapMaybe makenameurl $ concat $ rights l+	let nameurls = nub $ mapMaybe makenameurl $ concatMap toList $ rights l 	when (null nameurls) $ 		if (null $ rights l) 			then error $ unlines $ "Failed to query github for repos:" : map show (lefts l)@@ -551,13 +567,9 @@ 	excludeurls = map repoUrl exclude 	 	makenameurl repo = -#if MIN_VERSION_github(0,10,0) 		case Github.repoGitUrl repo of-			Just url -> Just (Github.repoName repo, url)+			Just url -> Just (T.unpack $ Github.untagName $ Github.repoName repo, T.unpack url) 			Nothing -> Nothing-#else-		Just (Github.repoName repo, Github.repoGitUrl repo)-#endif  	prepare (dir, url) 		| url `elem` excludeurls = return Nothing

@@ -0,0 +1,1 @@+[]

@@ -0,0 +1,1 @@+[]

@@ -22,5 +22,6 @@ .PP In order for gitriddance to log into GitHub, you need to set  the GITHUB_USER and GITHUB_PASSWORD environment variables.+Or, set GITHUB_OAUTH_TOKEN to an oath or personal access token. .SH AUTHOR  Joey Hess <joey@kitenet.net>

@@ -5,17 +5,15 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Main where -import qualified Github.Repos as Github-#if MIN_VERSION_github(0,9,0)-import qualified Github.Auth as Github-#endif-import qualified Github.Issues as Github-import qualified Github.Issues.Comments as Github+import qualified GitHub.Endpoints.Repos as Github+import qualified GitHub.Endpoints.Issues as Github+import qualified GitHub.Endpoints.Issues.Comments as Github+import qualified GitHub.Data.Id as Github import System.Environment+import Data.String+import qualified Data.Text as T  import Common import qualified Git@@ -47,17 +45,17 @@   where 	isorigin rmt = Git.remoteName rmt == Just "origin" -closeall :: Github.GithubAuth -> GithubUserRepo -> String -> IO ()+closeall :: Github.Auth -> GithubUserRepo -> String -> IO () closeall auth (GithubUserRepo user repo) msg = 	either (oops "getting issue list") (mapM_ close)-		=<< Github.issuesForRepo' (Just auth) user repo [Github.Open]+		=<< Github.issuesForRepo' (Just auth) (fromString user) (fromString repo) [Github.Open]   where 	oops action err = error $ "failed " ++ action ++ ": " ++ show err 	close issue = do 		let i = Github.issueNumber issue-		putStrLn $ "closing issue: " ++ Github.issueTitle issue+		putStrLn $ "closing issue: " ++ T.unpack (Github.issueTitle issue) 		either (oops "posting comment") (const $ return ())-			=<< Github.createComment auth user repo i msg+			=<< Github.createComment auth (fromString user) (fromString repo) (Github.mkId (Github.Id 0) i) (T.pack msg) 		either (oops "closing issue/pull") (const $ return ())-			=<< Github.editIssue auth user repo i-				(Github.editOfIssue { Github.editIssueState = Just "closed" } )+			=<< Github.editIssue auth (fromString user) (fromString repo) (Github.mkId (Github.Id 0) i)+				(Github.editOfIssue { Github.editIssueState = Just (T.pack "closed") } )

@@ -0,0 +1,35 @@+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-5.2++# Local packages, usually specified by relative directory name+packages:+- '.'++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 1.0.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]++# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor