diff --git a/56.patch b/56.patch new file mode 100644 --- /dev/null +++ b/56.patch @@ -0,0 +1,69 @@ +From c069ea587e52c435b4903271f3f9e287e9afe4a4 Mon Sep 17 00:00:00 2001 +From: Diogo Biazus +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 +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 diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 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. diff --git a/Github/Data/Readable.hs b/Github/Data/Readable.hs deleted file mode 100644 --- a/Github/Data/Readable.hs +++ /dev/null @@ -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 diff --git a/Github/EnumRepos.hs b/Github/EnumRepos.hs --- a/Github/EnumRepos.hs +++ b/Github/EnumRepos.hs @@ -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 diff --git a/Github/GetAuth.hs b/Github/GetAuth.hs --- a/Github/GetAuth.hs +++ b/Github/GetAuth.hs @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 +) 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 diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -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 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. diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -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 Standards-Version: 3.9.5 Vcs-Git: git://github.com/joeyh/github-backup.git diff --git a/github-backup.1 b/github-backup.1 --- a/github-backup.1 +++ b/github-backup.1 @@ -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 diff --git a/github-backup.cabal b/github-backup.cabal --- a/github-backup.cabal +++ b/github-backup.cabal @@ -1,5 +1,5 @@ Name: github-backup -Version: 1.20160207 +Version: 1.20160319 Cabal-Version: >= 1.8 Maintainer: Joey Hess 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) diff --git a/github-backup.hs b/github-backup.hs --- a/github-backup.hs +++ b/github-backup.hs @@ -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 diff --git a/github-backup.tmp/Administr8Me_github-backup/stargazers b/github-backup.tmp/Administr8Me_github-backup/stargazers new file mode 100644 --- /dev/null +++ b/github-backup.tmp/Administr8Me_github-backup/stargazers @@ -0,0 +1,1 @@ +[] diff --git a/github-backup.tmp/Administr8Me_github-backup/watchers b/github-backup.tmp/Administr8Me_github-backup/watchers new file mode 100644 --- /dev/null +++ b/github-backup.tmp/Administr8Me_github-backup/watchers @@ -0,0 +1,1 @@ +[] diff --git a/gitriddance.1 b/gitriddance.1 --- a/gitriddance.1 +++ b/gitriddance.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 diff --git a/gitriddance.hs b/gitriddance.hs --- a/gitriddance.hs +++ b/gitriddance.hs @@ -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") } ) diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /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