From be93c2ba5c120375fcfbdd142104945bee658a98 Mon Sep 17 00:00:00 2001 From: Tillmann Vogt Date: Mon, 9 Apr 2018 11:54:52 +0200 Subject: [PATCH 1/4] partial escape in query string --- github.cabal | 5 +- samples/Search/AllHaskellRepos.hs | 66 ++++++++ src/GitHub/Data/Definitions.hs | 3 +- src/GitHub/Data/Options.hs | 156 +++++++++++++++++- src/GitHub/Data/Request.hs | 9 + src/GitHub/Endpoints/GitData/Trees.hs | 4 +- src/GitHub/Endpoints/Organizations/Members.hs | 3 +- src/GitHub/Endpoints/Organizations/Teams.hs | 3 +- src/GitHub/Endpoints/Repos.hs | 13 +- src/GitHub/Endpoints/Repos/Commits.hs | 15 +- src/GitHub/Endpoints/Repos/Contents.hs | 3 +- src/GitHub/Endpoints/Search.hs | 79 ++++++--- src/GitHub/Request.hs | 9 +- 13 files changed, 314 insertions(+), 54 deletions(-) create mode 100644 samples/Search/AllHaskellRepos.hs diff --git a/github.cabal b/github.cabal index e9b632eb..e4781514 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github version: 0.19 -x-revision: 2 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -146,7 +145,7 @@ Library -- other packages build-depends: aeson >=0.7.0.6 && <1.4, - base-compat >=0.9.1 && <0.11, + base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, binary-orphans >=0.1.0.0 && <0.2, @@ -155,7 +154,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..be279bad --- /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..636fbf0a 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 W import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) @@ -232,7 +233,7 @@ 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, [W.EscapeItem])] -- | Count of elements type Count = Int diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 84105277..4890dd97 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, [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, [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, [W.QE v]) filt f x = case x of FilterAny -> Just "*" FilterNone -> Just "none" @@ -602,3 +613,142 @@ 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]) . W.QE . TE.encodeUtf8 + + -- example q=tetris+language:assembly+topic:ruby + -- into [QS "tetris", QPlus, QS "language", QColon, QS "assembly", QPlus, .. + plussedArgs = [W.QE (TE.encodeUtf8 searchRepoOptionsKeyword), W.QN "+"] ++ intercalate [W.QN "+"] + ( catMaybes [ ([W.QE "created", W.QN ":"] ++) <$> created' + , ([W.QE "pushed", W.QN ":"] ++) <$> pushed' + , ([W.QE "topic", W.QN ":"] ++) <$> topic' + , ([W.QE "language", W.QN ":"] ++) <$> language' + , ([W.QE "license", W.QN ":"] ++) <$> license' + ]) + + sort' x = case x of + Stars -> [W.QE "stars"] + Forks -> [W.QE "forks"] + Updated -> [W.QE "updated"] + + direction' x = case x of + SortDescending -> [W.QE "desc"] + SortAscending -> [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/Data/Request.hs b/src/GitHub/Data/Request.hs index c7d70e84..c46b7362 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -36,6 +36,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method +import qualified Network.HTTP.Types as W import Network.URI (URI) ------------------------------------------------------------------------------ -- Auxillary types @@ -241,6 +242,14 @@ instance Hashable (SimpleRequest k a) where `hashWithSalt` ps `hashWithSalt` body +instance Hashable W.EscapeItem where + hashWithSalt salt (W.QE b) = + salt `hashWithSalt` (0 :: Int) + `hashWithSalt` b + hashWithSalt salt (W.QN b) = + salt `hashWithSalt` (1 :: Int) + `hashWithSalt` b + instance Hashable (Request k a) where hashWithSalt salt (SimpleQuery req) = salt `hashWithSalt` (0 :: Int) diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 1806561a..21d4d6d2 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 W 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", [W.QE "1"])] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index d5b434c9..533ef18c 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,7 @@ 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", [W.QE f']), ("role", [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..1e0fe7f6 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -39,6 +39,7 @@ module GitHub.Endpoints.Organizations.Teams ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import qualified Network.HTTP.Types as W import Prelude () -- | List teams. List the teams of an Owner. @@ -133,7 +134,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", [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..06ac9901 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -55,14 +55,15 @@ module GitHub.Endpoints.Repos ( import GitHub.Data 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", [W.QE "all"])] +repoPublicityQueryString RepoPublicityOwner = [("type", [W.QE "owner"])] +repoPublicityQueryString RepoPublicityMember = [("type", [W.QE "member"])] +repoPublicityQueryString RepoPublicityPublic = [("type", [W.QE "public"])] +repoPublicityQueryString RepoPublicityPrivate = [("type", [W.QE "private"])] -- | List your repositories. currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) @@ -234,7 +235,7 @@ contributorsR contributorsR user repo anon = pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] 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..38a17d73 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -31,13 +31,14 @@ import Prelude () import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as TE - -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) +import qualified Network.HTTP.Types as W + +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. -- diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index d424b0c3..3cdc4c54 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -35,6 +35,7 @@ module GitHub.Endpoints.Repos.Contents ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import Network.HTTP.Types(EscapeItem(..)) import Prelude () import Data.Maybe (maybeToList) @@ -64,7 +65,7 @@ contentsForR contentsForR user repo path ref = query ["repos", toPathPart user, toPathPart repo, "contents", path] 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..aca9e8c8 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -15,72 +15,99 @@ module GitHub.Endpoints.Search( searchIssues', searchIssues, searchIssuesR, + W.EscapeItem(..), module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import qualified Network.HTTP.Types as W 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..00dc87ce 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -69,7 +69,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 +247,7 @@ makeHttpSimpleRequest auth r = case r of $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth - . setQueryString qs + . setQueryStringPartialEscape qs $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -254,7 +255,7 @@ makeHttpSimpleRequest auth r = case r of $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth - . setQueryString qs + . setQueryStringPartialEscape qs $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -297,7 +298,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)] From cccfc6ac0b954895c23120abd55d5b26936395e1 Mon Sep 17 00:00:00 2001 From: Tillmann Vogt Date: Mon, 9 Apr 2018 12:06:37 +0200 Subject: [PATCH 2/4] revision --- github.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/github.cabal b/github.cabal index e4781514..3a8d17ae 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,6 @@ name: github version: 0.19 +x-revision: 2 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full From 05d40fd747ba6acbc355d0a2f18ee2c119ab239d Mon Sep 17 00:00:00 2001 From: Tillmann Vogt Date: Mon, 9 Apr 2018 12:08:09 +0200 Subject: [PATCH 3/4] upper bound --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 3a8d17ae..ac516798 100644 --- a/github.cabal +++ b/github.cabal @@ -146,7 +146,7 @@ Library -- other packages build-depends: aeson >=0.7.0.6 && <1.4, - base-compat >=0.9.1 && <0.10, + base-compat >=0.9.1 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, binary-orphans >=0.1.0.0 && <0.2, From 0e157e2e9c2f75e44e34bc0ffe67f2155326eba1 Mon Sep 17 00:00:00 2001 From: Tillmann Vogt Date: Mon, 9 Apr 2018 17:29:36 +0200 Subject: [PATCH 4/4] no more orphan instance for EscapeItem --- samples/Search/AllHaskellRepos.hs | 2 +- src/GitHub/Data/Definitions.hs | 24 +++++++- src/GitHub/Data/Options.hs | 31 +++++----- src/GitHub/Data/Request.hs | 9 --- src/GitHub/Endpoints/GitData/Trees.hs | 4 +- src/GitHub/Endpoints/Organizations/Members.hs | 3 +- src/GitHub/Endpoints/Organizations/Teams.hs | 5 +- src/GitHub/Endpoints/Repos.hs | 13 +++-- src/GitHub/Endpoints/Repos/Commits.hs | 3 +- src/GitHub/Endpoints/Repos/Contents.hs | 3 +- src/GitHub/Endpoints/Search.hs | 57 ++++++++++--------- src/GitHub/Request.hs | 5 +- 12 files changed, 89 insertions(+), 70 deletions(-) diff --git a/samples/Search/AllHaskellRepos.hs b/samples/Search/AllHaskellRepos.hs index be279bad..8d67d27b 100644 --- a/samples/Search/AllHaskellRepos.hs +++ b/samples/Search/AllHaskellRepos.hs @@ -28,7 +28,7 @@ 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 + intervals "pass" start 10 -- stop after 10 queries a <- T.readFile authorsCsv T.writeFile authorsCsv (dups a) p <- T.readFile packagesCsv diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 636fbf0a..474cd7ff 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -15,7 +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 W +import qualified Network.HTTP.Types as Types import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) @@ -233,7 +233,27 @@ data OrgMemberRole deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | Request query string -type QueryString = [(BS.ByteString, [W.EscapeItem])] +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 4890dd97..c7d47631 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -309,7 +309,7 @@ pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = , mk "base" <$> base' ] where - mk k v = (k, [W.QE v]) + mk k v = (k, [Esc (W.QE v)]) state' = case st of Nothing -> "all" Just StateOpen -> "open" @@ -406,7 +406,7 @@ issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = , mk "since" <$> since' ] where - mk k v = (k, [W.QE v]) + mk k v = (k, [Esc (W.QE v)]) filt' = case filt of IssueFilterAssigned -> "assigned" IssueFilterCreated -> "created" @@ -554,7 +554,7 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = , mk "mentioned" <$> mentioned' ] where - mk k v = (k, [W.QE v]) + mk k v = (k, [Esc (W.QE v)]) filt f x = case x of FilterAny -> Just "*" FilterNone -> Just "none" @@ -718,26 +718,27 @@ searchRepoOptionsToQueryString SearchRepoOptions {..} = ] where mk k v = (k, v) - one = (\x -> [x]) . W.QE . TE.encodeUtf8 + 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 = [W.QE (TE.encodeUtf8 searchRepoOptionsKeyword), W.QN "+"] ++ intercalate [W.QN "+"] - ( catMaybes [ ([W.QE "created", W.QN ":"] ++) <$> created' - , ([W.QE "pushed", W.QN ":"] ++) <$> pushed' - , ([W.QE "topic", W.QN ":"] ++) <$> topic' - , ([W.QE "language", W.QN ":"] ++) <$> language' - , ([W.QE "license", W.QN ":"] ++) <$> license' + 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 -> [W.QE "stars"] - Forks -> [W.QE "forks"] - Updated -> [W.QE "updated"] + Stars -> [Esc (W.QE "stars")] + Forks -> [Esc (W.QE "forks")] + Updated -> [Esc (W.QE "updated")] direction' x = case x of - SortDescending -> [W.QE "desc"] - SortAscending -> [W.QE "asc"] + SortDescending -> [Esc (W.QE "desc")] + SortAscending -> [Esc (W.QE "asc")] created' = one . T.pack . (\(x,y) -> showGregorian x ++ ".." ++ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c46b7362..c7d70e84 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -36,7 +36,6 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method -import qualified Network.HTTP.Types as W import Network.URI (URI) ------------------------------------------------------------------------------ -- Auxillary types @@ -242,14 +241,6 @@ instance Hashable (SimpleRequest k a) where `hashWithSalt` ps `hashWithSalt` body -instance Hashable W.EscapeItem where - hashWithSalt salt (W.QE b) = - salt `hashWithSalt` (0 :: Int) - `hashWithSalt` b - hashWithSalt salt (W.QN b) = - salt `hashWithSalt` (1 :: Int) - `hashWithSalt` b - instance Hashable (Request k a) where hashWithSalt salt (SimpleQuery req) = salt `hashWithSalt` (0 :: Int) diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 21d4d6d2..26feefd3 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -18,7 +18,7 @@ module GitHub.Endpoints.GitData.Trees ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request -import qualified Network.HTTP.Types as W +import qualified Network.HTTP.Types as Types import Prelude () -- | A tree for a SHA1. @@ -58,4 +58,4 @@ nestedTree = nestedTree' Nothing 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", [W.QE "1"])] + [("recursive", [Esc (Types.QE "1")])] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 533ef18c..f1e3ccba 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -50,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", [W.QE f']), ("role", [W.QE 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 1e0fe7f6..dc9d43a3 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -39,9 +39,10 @@ module GitHub.Endpoints.Organizations.Teams ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request -import qualified Network.HTTP.Types as W 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. @@ -134,7 +135,7 @@ deleteTeamR tid = -- See listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) listTeamMembersR tid r = - pagedQuery ["teams", toPathPart tid, "members"] [("role", [W.QE 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 06ac9901..21e802d4 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -53,17 +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", [W.QE "all"])] -repoPublicityQueryString RepoPublicityOwner = [("type", [W.QE "owner"])] -repoPublicityQueryString RepoPublicityMember = [("type", [W.QE "member"])] -repoPublicityQueryString RepoPublicityPublic = [("type", [W.QE "public"])] -repoPublicityQueryString RepoPublicityPrivate = [("type", [W.QE "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)) @@ -233,7 +234,7 @@ 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", [W.QE "true"])] | otherwise = [] diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 38a17d73..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 () @@ -77,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 3cdc4c54..719d8fa3 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -33,6 +33,7 @@ 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(..)) @@ -63,7 +64,7 @@ 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", [QE (TE.encodeUtf8 r)] )]) ref diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index aca9e8c8..2b4f00bf 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -15,37 +15,35 @@ module GitHub.Endpoints.Search( searchIssues', searchIssues, searchIssuesR, - W.EscapeItem(..), module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request -import qualified Network.HTTP.Types as W import Prelude () -- | Perform a repository search. --- With authentication (5000 queries per hour). +-- With authentication (5000 queries per hour). -- --- > 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) +-- > 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 (60 queries per hour). +-- Without authentication (60 queries per hour). -- --- > let query search = search { searchRepoOptionsLanguage = Just (Language "Haskell") --- , searchRepoOptionsSortBy = Just Stars --- , searchRepoOptionsOrder = Just SortDescending --- , searchRepoOptionsCreated = Just (start, newDate) --- } --- res <- searchRepos (SearchRepoMod query) +-- > 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 @@ -60,21 +58,22 @@ searchReposR opts = -- | Perform a code search. -- With authentication (5000 queries per hour). -- --- 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"])] +-- > 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 (60 queries per hour). -- --- > res <- searchCode' [("q", [QE "language", QN ":", QE "haskell"]), --- ("sort", [QE "stars"]), --- ("order", [QE "desc"])] +-- > res <- searchCode' [("q", [QE "language", QN ":", QE "haskell"]), +-- > ("sort", [QE "stars"]), +-- > ("order", [QE "desc"])] searchCode :: QueryString -> IO (Either Error (SearchResult Code)) searchCode = searchCode' Nothing @@ -90,9 +89,10 @@ searchCodeR searchString = -- 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"])] +-- > [("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 @@ -101,8 +101,9 @@ searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- -- "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"])] +-- > ("per_page", [QE "100"])] searchIssues :: QueryString -> IO (Either Error (SearchResult Issue)) searchIssues = searchIssues' Nothing diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 00dc87ce..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) @@ -247,7 +248,7 @@ makeHttpSimpleRequest auth r = case r of $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth - . setQueryStringPartialEscape qs + . setQueryStringPartialEscape (unwrapEsc qs) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -255,7 +256,7 @@ makeHttpSimpleRequest auth r = case r of $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth - . setQueryStringPartialEscape qs + . setQueryStringPartialEscape (unwrapEsc qs) $ req Command m paths body -> do req <- parseUrl' $ url paths