diff --git a/github.cabal b/github.cabal index e9b632eb..ac516798 100644 --- a/github.cabal +++ b/github.cabal @@ -155,7 +155,7 @@ Library deepseq-generics >=0.1.1.2 && <0.3, exceptions >=0.8.0.2 && <0.11, hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.6, + http-client >=0.5.10 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, http-types >=0.12.1 && <0.13, diff --git a/samples/Search/AllHaskellRepos.hs b/samples/Search/AllHaskellRepos.hs new file mode 100644 index 00000000..8d67d27b --- /dev/null +++ b/samples/Search/AllHaskellRepos.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +module AllHaskellRepos where +import Control.Monad(when) +import Data.List(group, sort) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Vector as V +import Data.Time.Calendar(addDays, Day(..), showGregorian) +import Data.Time.Clock(getCurrentTime, UTCTime(..)) +import Data.Time.Format(parseTimeM, defaultTimeLocale, iso8601DateFormat) +import Time.System(dateCurrent) +import GitHub.Auth(Auth(..)) +import GitHub.Endpoints.Search(searchRepos', SearchResult(..), EscapeItem(..), + searchIssues') +import GitHub.Data.Repos +import GitHub.Data.Definitions +import GitHub.Data.Name +import GitHub.Data.URL +import GitHub.Data.Options(SearchRepoMod(..), SearchRepoOptions(..), Language(..), + License(..), StarsForksUpdated(..), SortDirection(..), + searchRepoModToQueryString) +import System.FilePath.Posix(FilePath) +import Debug.Trace + +-- | A search query finds all Haskell libraries on github +-- and updates two files of all packages/authors +updateGithub :: [FilePath] -> IO () +updateGithub [lastIntervalEnd, authorsCsv, packagesCsv] = do + lastEnd <- T.readFile lastIntervalEnd -- first time: 2008-03-01 + start <- parseTimeM True defaultTimeLocale (iso8601DateFormat Nothing) (T.unpack lastEnd) + intervals "pass" start 10 -- stop after 10 queries + a <- T.readFile authorsCsv + T.writeFile authorsCsv (dups a) + p <- T.readFile packagesCsv + T.writeFile packagesCsv (dups p) + where + dups = T.unlines . map head . group . sort . T.lines + -- Go through all github repos, by chosing small time intervals + intervals :: String -> Day -> Int -> IO () + intervals pass start i = do + let newDate = addDays 10 start -- assuming less than 100 repos in 10 days + + -- Remember the last succesfully scanned interval + -- (to update the list and continue when query timeout reached or query failed) + T.writeFile lastIntervalEnd (T.pack (showGregorian newDate)) + +-- https://api.github.com/search/repositories?q=language:haskell+created:2009-01-01..2009-02-01&sort=stars&order=desc + let query search = search { searchRepoOptionsLanguage = Just (Language "Haskell") + , searchRepoOptionsSortBy = Just Stars + , searchRepoOptionsOrder = Just SortDescending + , searchRepoOptionsCreated = Just (start, newDate) + } + res <- searchRepos' (Just $ BasicAuth "user" "pass") (SearchRepoMod query) + either (\_-> return ()) appendToCSV res +-- putStrLn (show res) -- for debugging + currentDate <- fmap utctDay getCurrentTime + when (newDate < currentDate && i>0) (intervals pass newDate (i-1)) + + appendToCSV :: SearchResult Repo -> IO () + appendToCSV res = do + V.mapM_ extractFromRepo (searchResultResults res) + where + extractFromRepo r = do + T.appendFile authorsCsv (untagName (simpleOwnerLogin (repoOwner r)) `T.append` "\n") + T.appendFile packagesCsv (getUrl (repoHtmlUrl r) `T.append` "\n") + diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index ea7ed2ea..474cd7ff 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -15,6 +15,7 @@ import Network.HTTP.Client (HttpException) import qualified Control.Exception as E import qualified Data.ByteString as BS import qualified Data.Text as T +import qualified Network.HTTP.Types as Types import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) @@ -232,7 +233,27 @@ data OrgMemberRole deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | Request query string -type QueryString = [(BS.ByteString, Maybe BS.ByteString)] +type QueryString = [(BS.ByteString, [EscapeItem])] + +newtype EscapeItem = Esc Types.EscapeItem deriving (Eq,Ord, Show) + +unwrapEsc :: [(BS.ByteString, [EscapeItem])] -> [(BS.ByteString, [Types.EscapeItem])] +unwrapEsc qs = map t qs + where t (bs, items) = (bs, map unesc items) + unesc (Esc i) = i + +wrapEsc :: [(BS.ByteString, [Types.EscapeItem])] -> [(BS.ByteString, [EscapeItem])] +wrapEsc qs = map t qs + where t (bs, items) = (bs, map Esc items) + +instance Hashable EscapeItem where + hashWithSalt salt (Esc (Types.QE b)) = + salt `hashWithSalt` (0 :: Int) + `hashWithSalt` b + hashWithSalt salt (Esc (Types.QN b)) = + salt `hashWithSalt` (1 :: Int) + `hashWithSalt` b + -- | Count of elements type Count = Int diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 84105277..c7d47631 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -44,6 +44,14 @@ module GitHub.Data.Options ( optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, + -- * Repo Search + SearchRepoMod(..), + searchRepoModToQueryString, + SearchRepoOptions(..), + SortDirection(..), + License(..), + Language(..), + StarsForksUpdated(..), -- * Data IssueState (..), MergeableState (..), @@ -56,13 +64,16 @@ module GitHub.Data.Options ( HasSince, ) where +import Data.Time.Calendar (Day, showGregorian) import GitHub.Data.Definitions import GitHub.Data.Id (Id, untagId) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name, untagName) +import GitHub.Data.Repos (Language(..)) import GitHub.Internal.Prelude import Prelude () +import qualified Network.HTTP.Types as W import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -298,7 +309,7 @@ pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = , mk "base" <$> base' ] where - mk k v = (k, Just v) + mk k v = (k, [Esc (W.QE v)]) state' = case st of Nothing -> "all" Just StateOpen -> "open" @@ -395,7 +406,7 @@ issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = , mk "since" <$> since' ] where - mk k v = (k, Just v) + mk k v = (k, [Esc (W.QE v)]) filt' = case filt of IssueFilterAssigned -> "assigned" IssueFilterCreated -> "created" @@ -543,7 +554,7 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = , mk "mentioned" <$> mentioned' ] where - mk k v = (k, Just v) + mk k v = (k, [Esc (W.QE v)]) filt f x = case x of FilterAny -> Just "*" FilterNone -> Just "none" @@ -602,3 +613,143 @@ optionsAnyAssignee = IssueRepoMod $ \opts -> optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNone } + +------------------------------------------------------------------------------------ +-- SearchRepo Options +------------------------------------------------------------------------------------ + +data StarsForksUpdated + = Stars + | Forks + | Updated + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON StarsForksUpdated where + toJSON Stars = String "stars" + toJSON Forks = String "forks" + toJSON Updated = String "updated" + +instance FromJSON StarsForksUpdated where + parseJSON (String "stars") = pure Stars + parseJSON (String "forks") = pure Forks + parseJSON (String "updated") = pure Updated + parseJSON v = typeMismatch "StarsForksUpdated" v + +newtype License = License Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data RepoUser = Repo | User + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +data RepoIn = RName | RDescription | Readme + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +type Topic = String + +data SearchRepoOptions = SearchRepoOptions + { searchRepoOptionsKeyword :: !Text + , searchRepoOptionsSortBy :: !(Maybe StarsForksUpdated) + , searchRepoOptionsOrder :: !(Maybe SortDirection) + , searchRepoOptionsCreated :: !(Maybe (Day, Day)) -- period + , searchRepoOptionsPushed :: !(Maybe (Day, Day)) + , searchRepoOptionsFork :: !(Maybe Bool) + , searchRepoOptionsForks :: !(Maybe Int) + , searchRepoOptionsIn :: !(Maybe RepoIn) + , searchRepoOptionsLanguage :: !(Maybe Language) + , searchRepoOptionsLicense :: !(Maybe License) + , searchRepoOptionsRepoUser :: !(Maybe RepoUser) + , searchRepoOptionsSize :: !(Maybe Int) + , searchRepoOptionsStars :: !(Maybe Int) + , searchRepoOptionsTopic :: !(Maybe Topic) + , searchRepoOptionsArchived :: !(Maybe Bool) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultSearchRepoOptions :: SearchRepoOptions +defaultSearchRepoOptions = SearchRepoOptions + { searchRepoOptionsKeyword = "" + , searchRepoOptionsSortBy = Nothing + , searchRepoOptionsOrder = Nothing + , searchRepoOptionsCreated = Nothing + , searchRepoOptionsPushed = Nothing + , searchRepoOptionsFork = Nothing + , searchRepoOptionsForks = Nothing + , searchRepoOptionsIn = Nothing + , searchRepoOptionsLanguage = Nothing + , searchRepoOptionsLicense = Nothing + , searchRepoOptionsRepoUser = Nothing + , searchRepoOptionsSize = Nothing + , searchRepoOptionsStars = Nothing + , searchRepoOptionsTopic = Nothing + , searchRepoOptionsArchived = Nothing + } + +-- | See . +newtype SearchRepoMod = SearchRepoMod (SearchRepoOptions -> SearchRepoOptions) + +instance Semigroup SearchRepoMod where + SearchRepoMod f <> SearchRepoMod g = SearchRepoMod (g . f) + +instance Monoid SearchRepoMod where + mempty = SearchRepoMod id + mappend = (<>) + +toSearchRepoOptions :: SearchRepoMod -> SearchRepoOptions +toSearchRepoOptions (SearchRepoMod f) = f defaultSearchRepoOptions + +searchRepoModToQueryString :: SearchRepoMod -> QueryString +searchRepoModToQueryString = searchRepoOptionsToQueryString . toSearchRepoOptions + +searchRepoOptionsToQueryString :: SearchRepoOptions -> QueryString +searchRepoOptionsToQueryString SearchRepoOptions {..} = + [ ("q", plussedArgs) + ] ++ catMaybes + [ mk "sort" <$> fmap sort' searchRepoOptionsSortBy + , mk "order" <$> fmap direction' searchRepoOptionsOrder + , mk "fork" <$> fmap (one . T.pack . show) searchRepoOptionsFork + , mk "forks" <$> fmap (one . T.pack . show) searchRepoOptionsForks + , mk "size" <$> fmap (one . T.pack . show) searchRepoOptionsSize + , mk "stars" <$> fmap (one . T.pack . show) searchRepoOptionsStars + , mk "archived" <$> fmap (one . T.pack . show) searchRepoOptionsArchived + ] + where + mk k v = (k, v) + one = (\x -> [x]) . Esc . W.QE . TE.encodeUtf8 + + -- example q=tetris+language:assembly+topic:ruby + -- into [QS "tetris", QPlus, QS "language", QColon, QS "assembly", QPlus, .. + plussedArgs = [Esc (W.QE (TE.encodeUtf8 searchRepoOptionsKeyword)), + Esc (W.QN "+")] ++ intercalate [Esc (W.QN "+")] + ( catMaybes [ ([Esc (W.QE "created"), Esc (W.QN ":")] ++) <$> created' + , ([Esc (W.QE "pushed"), Esc (W.QN ":")] ++) <$> pushed' + , ([Esc (W.QE "topic"), Esc (W.QN ":")] ++) <$> topic' + , ([Esc (W.QE "language"), Esc (W.QN ":")] ++) <$> language' + , ([Esc (W.QE "license"), Esc (W.QN ":")] ++) <$> license' + ]) + + sort' x = case x of + Stars -> [Esc (W.QE "stars")] + Forks -> [Esc (W.QE "forks")] + Updated -> [Esc (W.QE "updated")] + + direction' x = case x of + SortDescending -> [Esc (W.QE "desc")] + SortAscending -> [Esc (W.QE "asc")] + + created' = one . T.pack . (\(x,y) -> showGregorian x + ++ ".." ++ + showGregorian y) <$> searchRepoOptionsCreated + + pushed' = one . T.pack . (\(x,y) -> showGregorian x + ++ ".." ++ + showGregorian y) <$> searchRepoOptionsPushed + topic' = one . T.pack <$> searchRepoOptionsTopic + language' = one . (\(Language x) -> x) <$> searchRepoOptionsLanguage + + -- see + license' = one . (\(License x) -> x) <$> searchRepoOptionsLicense + diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 1806561a..26feefd3 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -18,6 +18,7 @@ module GitHub.Endpoints.GitData.Trees ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import qualified Network.HTTP.Types as Types import Prelude () -- | A tree for a SHA1. @@ -56,4 +57,5 @@ nestedTree = nestedTree' Nothing -- See nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = - query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] + query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] + [("recursive", [Esc (Types.QE "1")])] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index d5b434c9..f1e3ccba 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -20,6 +20,7 @@ module GitHub.Endpoints.Organizations.Members ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import qualified Network.HTTP.Types as W import Prelude () -- | All the users who are members of the specified organization, @@ -49,7 +50,8 @@ membersOfR organization = -- See membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) membersOfWithR org f r = - pagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] + pagedQuery ["orgs", toPathPart org, "members"] + [("filter", [Esc (W.QE f')]), ("role", [Esc (W.QE r')])] where f' = case f of OrgMemberFilter2faDisabled -> "2fa_disabled" diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 04af873e..dc9d43a3 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -41,6 +41,8 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () +import qualified Network.HTTP.Types as W + -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. -- When unauthenticated, lists only public teams for an Owner. @@ -133,7 +135,7 @@ deleteTeamR tid = -- See listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) listTeamMembersR tid r = - pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] + pagedQuery ["teams", toPathPart tid, "members"] [("role", [Esc (W.QE r')])] where r' = case r of TeamMemberRoleAll -> "all" diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d9ad44a1..21e802d4 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -53,16 +53,18 @@ module GitHub.Endpoints.Repos ( ) where import GitHub.Data +import GitHub.Data.Definitions(wrapEsc) import GitHub.Internal.Prelude import GitHub.Request +import qualified Network.HTTP.Types as W import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString -repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] -repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] -repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] -repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] -repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] +repoPublicityQueryString RepoPublicityAll = [("type", [Esc (W.QE "all")])] +repoPublicityQueryString RepoPublicityOwner = [("type", [Esc (W.QE "owner")])] +repoPublicityQueryString RepoPublicityMember = [("type", [Esc (W.QE "member")])] +repoPublicityQueryString RepoPublicityPublic = [("type", [Esc (W.QE "public")])] +repoPublicityQueryString RepoPublicityPrivate = [("type", [Esc (W.QE "private")])] -- | List your repositories. currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) @@ -232,9 +234,9 @@ contributorsR -> FetchCount -> Request k (Vector Contributor) contributorsR user repo anon = - pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs + pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] (wrapEsc qs) where - qs | anon = [("anon", Just "true")] + qs | anon = [("anon", [W.QE "true"])] | otherwise = [] -- | The contributors to a repo, including anonymous contributors (such as diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index ba86ed40..b9820e00 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -24,6 +24,7 @@ module GitHub.Endpoints.Repos.Commits ( ) where import GitHub.Data +import GitHub.Data.Definitions(wrapEsc) import GitHub.Internal.Prelude import GitHub.Request import Prelude () @@ -31,13 +32,14 @@ import Prelude () import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import qualified Network.HTTP.Types as W -renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) -renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) -renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) -renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) -renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) -renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) +renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, [W.EscapeItem]) +renderCommitQueryOption (CommitQuerySha sha) = ("sha", [W.QE $ TE.encodeUtf8 sha]) +renderCommitQueryOption (CommitQueryPath path) = ("path", [W.QE $ TE.encodeUtf8 path]) +renderCommitQueryOption (CommitQueryAuthor author) = ("author", [W.QE $ TE.encodeUtf8 author]) +renderCommitQueryOption (CommitQuerySince date) = ("since", [W.QE $ TE.encodeUtf8 . T.pack $ formatISO8601 date]) +renderCommitQueryOption (CommitQueryUntil date) = ("until", [W.QE $ TE.encodeUtf8 . T.pack $ formatISO8601 date]) -- | The commit history for a repo. -- @@ -76,7 +78,7 @@ commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryO commitsWithOptionsForR user repo limit opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where - qs = map renderCommitQueryOption opts + qs = wrapEsc (map renderCommitQueryOption opts) -- | Details on a specific SHA1 for a repo. diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index d424b0c3..719d8fa3 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -33,8 +33,10 @@ module GitHub.Endpoints.Repos.Contents ( ) where import GitHub.Data +import GitHub.Data.Definitions(wrapEsc) import GitHub.Internal.Prelude import GitHub.Request +import Network.HTTP.Types(EscapeItem(..)) import Prelude () import Data.Maybe (maybeToList) @@ -62,9 +64,9 @@ contentsForR -> Maybe Text -- ^ Git commit -> Request k Content contentsForR user repo path ref = - query ["repos", toPathPart user, toPathPart repo, "contents", path] qs + query ["repos", toPathPart user, toPathPart repo, "contents", path] (wrapEsc qs) where - qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref + qs = maybe [] (\r -> [("ref", [QE (TE.encodeUtf8 r)] )]) ref -- | The contents of a README file in a repo, given the repo owner and name -- diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 58a0e4e5..2b4f00bf 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -23,64 +23,92 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () -import qualified Data.Text.Encoding as TE - -- | Perform a repository search. --- With authentication. +-- With authentication (5000 queries per hour). -- --- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) -searchRepos' auth = executeRequestMaybe auth . searchReposR +-- > let query search = search { searchRepoOptionsLanguage = Just (Language "Haskell") +-- > , searchRepoOptionsSortBy = Just Stars +-- > , searchRepoOptionsOrder = Just SortDescending +-- > , searchRepoOptionsCreated = Just (start, newDate) +-- > } +-- > res <- searchRepos' (Just $ BasicAuth "github-username" "github-password") (SearchRepoMod query) +searchRepos' :: Maybe Auth -> SearchRepoMod -> IO (Either Error (SearchResult Repo)) +searchRepos' auth opts = executeRequestMaybe auth $ searchReposR opts -- | Perform a repository search. --- Without authentication. +-- Without authentication (60 queries per hour). -- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: Text -> IO (Either Error (SearchResult Repo)) +-- > let query search = search { searchRepoOptionsLanguage = Just (Language "Haskell") +-- > , searchRepoOptionsSortBy = Just Stars +-- > , searchRepoOptionsOrder = Just SortDescending +-- > , searchRepoOptionsCreated = Just (start, newDate) +-- > } +-- > res <- searchRepos (SearchRepoMod query) +searchRepos :: SearchRepoMod -> IO (Either Error (SearchResult Repo)) searchRepos = searchRepos' Nothing -- | Search repositories. -- See -searchReposR :: Text -> Request k (SearchResult Repo) -searchReposR searchString = - query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] +searchReposR :: SearchRepoMod -> Request k (SearchResult Repo) +searchReposR opts = + query ["search", "repositories"] qs + where + qs = searchRepoModToQueryString opts -- | Perform a code search. --- With authentication. +-- With authentication (5000 queries per hour). -- --- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) +-- > QE = URI encode +-- > QN = Not URI encode +-- +-- > res <- searchCode' (Just $ BasicAuth "github-username" "github-password") +-- > [("q", [QE "language", QN ":", QE "haskell"]), +-- > ("sort", [QE "stars"]), +-- > ("order", [QE "desc"])] +searchCode' :: Maybe Auth -> QueryString -> IO (Either Error (SearchResult Code)) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. --- Without authentication. +-- Without authentication (60 queries per hour). -- --- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: Text -> IO (Either Error (SearchResult Code)) +-- > res <- searchCode' [("q", [QE "language", QN ":", QE "haskell"]), +-- > ("sort", [QE "stars"]), +-- > ("order", [QE "desc"])] +searchCode :: QueryString -> IO (Either Error (SearchResult Code)) searchCode = searchCode' Nothing -- | Search code. -- See -searchCodeR :: Text -> Request k (SearchResult Code) +searchCodeR :: QueryString -> Request k (SearchResult Code) searchCodeR searchString = - query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] + query ["search", "code"] searchString -- | Perform an issue search. -- With authentication. -- --- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) +-- Because of URI encoding +-- "q=a+repo:phadej/github&per_page=100" +-- has to be written as +-- +-- > searchIssues' (Just $ BasicAuth "github-username" "github-password") +-- > [("q", [QE "a", QN "+", QE "repo", QN ":", QE "phadej", QN "/", QE "github"]), +-- > ("per_page", [QE "100"])] +searchIssues' :: Maybe Auth -> QueryString -> IO (Either Error (SearchResult Issue)) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. -- Without authentication. -- --- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: Text -> IO (Either Error (SearchResult Issue)) +-- "q=a+repo:phadej/github&per_page=100" +-- has to be written as +-- +-- > searchIssues [("q", [QE "a", QN "+", QE "repo", QN ":", QE "phadej", QN "/", QE "github"]), +-- > ("per_page", [QE "100"])] +searchIssues :: QueryString -> IO (Either Error (SearchResult Issue)) searchIssues = searchIssues' Nothing -- | Search issues. -- See -searchIssuesR :: Text -> Request k (SearchResult Issue) +searchIssuesR :: QueryString -> Request k (SearchResult Issue) searchIssuesR searchString = - query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + query ["search", "issues"] searchString diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index e9f9cddd..07931481 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -51,6 +51,7 @@ module GitHub.Request ( ) where import GitHub.Internal.Prelude +import GitHub.Data.Definitions(unwrapEsc) import Prelude () #if MIN_VERSION_mtl(2,2,0) @@ -69,7 +70,8 @@ import Data.List (find) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount, - requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) + requestBody, requestHeaders, setQueryStringPartialEscape, + setRequestIgnoreStatus) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) @@ -246,7 +248,7 @@ makeHttpSimpleRequest auth r = case r of $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth - . setQueryString qs + . setQueryStringPartialEscape (unwrapEsc qs) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -254,7 +256,7 @@ makeHttpSimpleRequest auth r = case r of $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth - . setQueryString qs + . setQueryStringPartialEscape (unwrapEsc qs) $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -297,7 +299,7 @@ makeHttpSimpleRequest auth r = case r of setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass - setAuthRequest _ = id + setAuthRequest _ = id getOAuthHeader :: Auth -> RequestHeaders getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)]