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)] pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy