From c03f5596183e33d12f2164b52f6f8e4efc3ead56 Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Fri, 23 Feb 2024 19:12:46 -0800
Subject: [PATCH 01/11] Working on PerPageQuery

---
 src/GitHub/Data/Request.hs | 47 +++++++++++++++++++++++++++++++--
 src/GitHub/Request.hs      | 53 +++++++++++++++++++++++++++++++++++++-
 2 files changed, 97 insertions(+), 3 deletions(-)

diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs
index 445c4223..b6cf45b0 100644
--- a/src/GitHub/Data/Request.hs
+++ b/src/GitHub/Data/Request.hs
@@ -9,12 +9,14 @@ module GitHub.Data.Request (
     Request,
     GenRequest (..),
     -- * Smart constructors
-    query, pagedQuery, command,
+    query, pagedQuery, perPageQuery, command,
     -- * Auxiliary types
     RW(..),
     CommandMethod(..),
     toMethod,
     FetchCount(..),
+    PageParams(..),
+    PageLinks(..),
     MediaType (..),
     Paths,
     IsPathPart(..),
@@ -30,6 +32,7 @@ import GitHub.Internal.Prelude
 import qualified Data.ByteString.Lazy      as LBS
 import qualified Data.Text                 as T
 import qualified Network.HTTP.Types.Method as Method
+import Network.URI (URI)
 
 ------------------------------------------------------------------------------
 -- Path parts
@@ -97,6 +100,37 @@ instance Hashable FetchCount
 instance Binary FetchCount
 instance NFData FetchCount where rnf = genericRnf
 
+-------------------------------------------------------------------------------
+-- PageParams
+-------------------------------------------------------------------------------
+
+-- | Params for specifying the precise page and items per page.
+data PageParams = PageParams {
+  pageParamsPerPage :: Maybe Int
+  , pageParamsPage :: Maybe Int
+  }
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance Hashable PageParams
+instance Binary PageParams
+instance NFData PageParams where rnf = genericRnf
+
+-------------------------------------------------------------------------------
+-- PageLinks
+-------------------------------------------------------------------------------
+
+-- | 'PagedQuery' returns just some results, using this data we can specify how
+-- many pages we want to fetch.
+data PageLinks = PageLinks {
+  pageLinksPrev :: Maybe URI
+  , pageLinksNext :: Maybe URI
+  , pageLinksLast :: Maybe URI
+  , pageLinksFirst :: Maybe URI
+  }
+    deriving (Eq, Ord, Show, Generic, Typeable)
+
+instance NFData PageLinks where rnf = genericRnf
+
 -------------------------------------------------------------------------------
 -- MediaType
 -------------------------------------------------------------------------------
@@ -151,6 +185,7 @@ instance IReadOnly 'RA        where iro = ROA
 data GenRequest (mt :: MediaType *) (rw :: RW) a where
     Query        :: Paths -> QueryString -> GenRequest mt rw a
     PagedQuery   :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a
+    PerPageQuery   :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> PageParams -> GenRequest mt rw (a, PageLinks)
 
     -- | Command
     Command
@@ -173,6 +208,9 @@ query ps qs = Query ps qs
 pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a)
 pagedQuery ps qs fc = PagedQuery ps qs fc
 
+perPageQuery :: FromJSON a => Paths -> QueryString -> PageParams -> Request mt (Vector a, PageLinks)
+perPageQuery ps qs pp = PerPageQuery ps qs pp
+
 command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a
 command m ps body = Command m ps body
 
@@ -194,8 +232,13 @@ instance Hashable (GenRequest rw mt a) where
              `hashWithSalt` ps
              `hashWithSalt` qs
              `hashWithSalt` l
-    hashWithSalt salt (Command m ps body) =
+    hashWithSalt salt (PerPageQuery ps qs pp) =
         salt `hashWithSalt` (2 :: Int)
+             `hashWithSalt` ps
+             `hashWithSalt` qs
+             `hashWithSalt` pp
+    hashWithSalt salt (Command m ps body) =
+        salt `hashWithSalt` (3 :: Int)
              `hashWithSalt` m
              `hashWithSalt` ps
              `hashWithSalt` body
diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index c5eb006c..db5b9f66 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -79,6 +79,7 @@ import Control.Monad.Trans.Class  (lift)
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Data.Aeson                 (eitherDecode)
 import Data.List                  (find)
+import Data.Maybe                 (fromMaybe)
 import Data.Tagged                (Tagged (..))
 import Data.Version               (showVersion)
 
@@ -87,13 +88,14 @@ import Network.HTTP.Client
        httpLbs, method, newManager, redirectCount, requestBody, requestHeaders,
        setQueryString, setRequestIgnoreStatus)
 import Network.HTTP.Link.Parser (parseLinkHeaderBS)
-import Network.HTTP.Link.Types  (LinkParam (..), href, linkParams)
+import Network.HTTP.Link.Types  (Link(..), LinkParam (..), href, linkParams)
 import Network.HTTP.Types       (Method, RequestHeaders, Status (..))
 import Network.URI
        (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference,
        relativeTo)
 
 import qualified Data.ByteString              as BS
+import           Data.ByteString.Builder      (intDec, toLazyByteString)
 import qualified Data.ByteString.Lazy         as LBS
 import qualified Data.Text                    as T
 import qualified Data.Text.Encoding           as TE
@@ -240,6 +242,10 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
       where
         predicate v = lessFetchCount (length v) l
 
+    performHttpReq httpReq (PerPageQuery _ _ _) = do
+        (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
+        pure res
+
     performHttpReq httpReq (Command _ _ _) = do
         res <- httpLbs' httpReq
         (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
@@ -466,6 +472,18 @@ makeHttpRequest auth r = case r of
             . maybe id setAuthRequest auth
             . setQueryString qs
             $ req
+    PerPageQuery paths qs pp -> do
+        req <- parseUrl' $ url paths
+        let extraQueryItems = catMaybes [
+              (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
+              , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
+              ]
+        return
+            $ setReqHeaders
+            . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
+            . maybe id setAuthRequest auth
+            . setQueryString (qs <> extraQueryItems)
+            $ req
     Command m paths body -> do
         req <- parseUrl' $ url paths
         return
@@ -542,6 +560,39 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do
                 go (acc <> m) res' req'
             (_, _)           -> return (acc <$ res)
 
+-- | Helper for making paginated requests. Responses, @a@ are combined monoidally.
+--
+-- The result is wrapped in the last received 'HTTP.Response'.
+--
+-- @
+-- performPerPageRequest :: ('FromJSON' a, 'Semigroup' a)
+--                       => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' 'LBS.ByteString'))
+--                       -> (a -> 'Bool')
+--                       -> 'HTTP.Request'
+--                       -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a)
+-- @
+performPerPageRequest
+    :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m)
+    => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
+    -> HTTP.Request                                        -- ^ initial request
+    -> Tagged mt (m (HTTP.Response a, PageLinks))
+performPerPageRequest httpLbs' initReq = Tagged $ do
+    res <- httpLbs' initReq
+
+    let links :: [Link URI] = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
+
+    let linkToUri (Link uri _) = uri
+
+    let pageLinks = PageLinks {
+          pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
+          , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
+          , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
+          , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
+          }
+
+    m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
+    return (m <$ res, pageLinks)
+
 -------------------------------------------------------------------------------
 -- Internal
 -------------------------------------------------------------------------------

From d17426fae41b9c04a38dd2e07972bdb7304f697d Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Sun, 25 Feb 2024 22:34:47 -0800
Subject: [PATCH 02/11] Add issuesForRepoPagedR + failing test

---
 spec/GitHub/IssuesSpec.hs      | 16 ++++++++++++++++
 src/GitHub.hs                  |  1 +
 src/GitHub/Data/Request.hs     |  7 +++++++
 src/GitHub/Endpoints/Issues.hs |  9 +++++++++
 4 files changed, 33 insertions(+)

diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs
index 2a7f5e7b..94ed9ef2 100644
--- a/spec/GitHub/IssuesSpec.hs
+++ b/spec/GitHub/IssuesSpec.hs
@@ -12,6 +12,7 @@ import Data.String        (fromString)
 import System.Environment (lookupEnv)
 import Test.Hspec
        (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
+import GitHub.Data.Request (PageParams(PageParams))
 
 fromRightS :: Show a => Either a b -> b
 fromRightS (Right b) = b
@@ -38,6 +39,21 @@ spec = do
                   cms <- GitHub.executeRequest auth $
                     GitHub.commentsR owner repo (GitHub.issueNumber i) 1
                   cms `shouldSatisfy` isRight
+
+    describe "issuesForRepoPagedR" $ do
+        it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
+            cs <- GitHub.executeRequest auth $
+                GitHub.issuesForRepoPagedR owner repo mempty (PageParams (Just 2) (Just 1))
+            case cs of
+              Left e ->
+                expectationFailure . show $ e
+              Right (cs', pageLinks) -> do
+                putStrLn ("GOT PAGE LINKS: " <> show pageLinks)
+                for_ cs' $ \i -> do
+                  cms <- GitHub.executeRequest auth $
+                    GitHub.commentsR owner repo (GitHub.issueNumber i) 1
+                  cms `shouldSatisfy` isRight
+
     describe "issueR" $ do
         it "fetches issue #428" $ withAuth $ \auth -> do
             resIss <- GitHub.executeRequest auth $
diff --git a/src/GitHub.hs b/src/GitHub.hs
index c3a3d88f..dd6b0a79 100644
--- a/src/GitHub.hs
+++ b/src/GitHub.hs
@@ -111,6 +111,7 @@ module GitHub (
     organizationIssuesR,
     issueR,
     issuesForRepoR,
+    issuesForRepoPagedR,
     createIssueR,
     editIssueR,
 
diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs
index b6cf45b0..174f0cb8 100644
--- a/src/GitHub/Data/Request.hs
+++ b/src/GitHub/Data/Request.hs
@@ -131,6 +131,13 @@ data PageLinks = PageLinks {
 
 instance NFData PageLinks where rnf = genericRnf
 
+instance FromJSON PageLinks where
+    parseJSON = withObject "PageLinks" $ \o -> PageLinks
+        <$> o .:? "prev"
+        <*> o .:? "next"
+        <*> o .:? "last"
+        <*> o .:? "first"
+
 -------------------------------------------------------------------------------
 -- MediaType
 -------------------------------------------------------------------------------
diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs
index 9cd7258f..afcfd47a 100644
--- a/src/GitHub/Endpoints/Issues.hs
+++ b/src/GitHub/Endpoints/Issues.hs
@@ -8,6 +8,7 @@ module GitHub.Endpoints.Issues (
     organizationIssuesR,
     issueR,
     issuesForRepoR,
+    issuesForRepoPagedR,
     createIssueR,
     newIssue,
     editIssueR,
@@ -43,6 +44,14 @@ issuesForRepoR user reqRepoName opts =
   where
     qs = issueRepoModToQueryString opts
 
+-- | List issues for a repository.
+-- See <https://developer.github.com/v3/issues/#list-issues-for-a-repository>
+issuesForRepoPagedR :: Name Owner -> Name Repo -> IssueRepoMod -> PageParams -> Request k (Vector Issue, PageLinks)
+issuesForRepoPagedR user reqRepoName opts =
+    perPageQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs
+  where
+    qs = issueRepoModToQueryString opts
+
 -- Creating new issues.
 
 newIssue :: Text -> NewIssue

From 80b79cf0aba34035be2e351a4ac659c880c41e8c Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Sun, 25 Feb 2024 22:34:58 -0800
Subject: [PATCH 03/11] Testing, todo REVERT

---
 src/GitHub/Request.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index db5b9f66..6453e94d 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -76,6 +76,7 @@ import Control.Monad.Error.Class (MonadError (..))
 import Control.Monad              (when)
 import Control.Monad.Catch        (MonadCatch (..), MonadThrow)
 import Control.Monad.Trans.Class  (lift)
+import Control.Monad.IO.Class     (MonadIO (..))
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Data.Aeson                 (eitherDecode)
 import Data.List                  (find)
@@ -243,7 +244,9 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
         predicate v = lessFetchCount (length v) l
 
     performHttpReq httpReq (PerPageQuery _ _ _) = do
+        lift $ putStrLn "GOT HERE 1"
         (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
+        lift $ putStrLn "GOT HERE 2"
         pure res
 
     performHttpReq httpReq (Command _ _ _) = do
@@ -572,13 +575,15 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do
 --                       -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a)
 -- @
 performPerPageRequest
-    :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m)
+    :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m, MonadIO m)
     => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
     -> HTTP.Request                                        -- ^ initial request
     -> Tagged mt (m (HTTP.Response a, PageLinks))
 performPerPageRequest httpLbs' initReq = Tagged $ do
     res <- httpLbs' initReq
 
+    liftIO $ putStrLn ("performPerPageRequest: Got res: " <> show res)
+
     let links :: [Link URI] = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
 
     let linkToUri (Link uri _) = uri
@@ -590,7 +595,12 @@ performPerPageRequest httpLbs' initReq = Tagged $ do
           , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
           }
 
+    liftIO $ putStrLn ("performPerPageRequest: Got page links: " <> show pageLinks)
+
     m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
+
+    liftIO $ putStrLn ("performPerPageRequest: Got here")
+
     return (m <$ res, pageLinks)
 
 -------------------------------------------------------------------------------

From cb03a51c3b9c66991e511c906285c5ffe8428cff Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:04:37 -0800
Subject: [PATCH 04/11] About to try integrating paging into the normal
 executeRequest calls

---
 spec/GitHub/IssuesSpec.hs      |  4 +-
 src/GitHub.hs                  |  1 -
 src/GitHub/Data/Request.hs     | 23 +++-------
 src/GitHub/Endpoints/Issues.hs |  9 ----
 src/GitHub/Request.hs          | 81 ++++++++++++++++++++++++----------
 5 files changed, 64 insertions(+), 54 deletions(-)

diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs
index 94ed9ef2..ffe574e5 100644
--- a/spec/GitHub/IssuesSpec.hs
+++ b/spec/GitHub/IssuesSpec.hs
@@ -42,8 +42,8 @@ spec = do
 
     describe "issuesForRepoPagedR" $ do
         it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
-            cs <- GitHub.executeRequest auth $
-                GitHub.issuesForRepoPagedR owner repo mempty (PageParams (Just 2) (Just 1))
+            cs <- GitHub.executeRequestPaged auth (PageParams (Just 2) (Just 1)) $
+                GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll
             case cs of
               Left e ->
                 expectationFailure . show $ e
diff --git a/src/GitHub.hs b/src/GitHub.hs
index dd6b0a79..c3a3d88f 100644
--- a/src/GitHub.hs
+++ b/src/GitHub.hs
@@ -111,7 +111,6 @@ module GitHub (
     organizationIssuesR,
     issueR,
     issuesForRepoR,
-    issuesForRepoPagedR,
     createIssueR,
     editIssueR,
 
diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs
index 174f0cb8..a954ba0f 100644
--- a/src/GitHub/Data/Request.hs
+++ b/src/GitHub/Data/Request.hs
@@ -9,7 +9,7 @@ module GitHub.Data.Request (
     Request,
     GenRequest (..),
     -- * Smart constructors
-    query, pagedQuery, perPageQuery, command,
+    query, pagedQuery, command,
     -- * Auxiliary types
     RW(..),
     CommandMethod(..),
@@ -78,7 +78,10 @@ toMethod Delete = Method.methodDelete
 
 -- | 'PagedQuery' returns just some results, using this data we can specify how
 -- many pages we want to fetch.
-data FetchCount = FetchAtLeast !Word | FetchAll
+data FetchCount =
+    FetchAtLeast !Word
+    | FetchAll
+    | FetchPage PageParams
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
@@ -131,13 +134,6 @@ data PageLinks = PageLinks {
 
 instance NFData PageLinks where rnf = genericRnf
 
-instance FromJSON PageLinks where
-    parseJSON = withObject "PageLinks" $ \o -> PageLinks
-        <$> o .:? "prev"
-        <*> o .:? "next"
-        <*> o .:? "last"
-        <*> o .:? "first"
-
 -------------------------------------------------------------------------------
 -- MediaType
 -------------------------------------------------------------------------------
@@ -192,7 +188,6 @@ instance IReadOnly 'RA        where iro = ROA
 data GenRequest (mt :: MediaType *) (rw :: RW) a where
     Query        :: Paths -> QueryString -> GenRequest mt rw a
     PagedQuery   :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a
-    PerPageQuery   :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> PageParams -> GenRequest mt rw (a, PageLinks)
 
     -- | Command
     Command
@@ -215,9 +210,6 @@ query ps qs = Query ps qs
 pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a)
 pagedQuery ps qs fc = PagedQuery ps qs fc
 
-perPageQuery :: FromJSON a => Paths -> QueryString -> PageParams -> Request mt (Vector a, PageLinks)
-perPageQuery ps qs pp = PerPageQuery ps qs pp
-
 command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a
 command m ps body = Command m ps body
 
@@ -239,11 +231,6 @@ instance Hashable (GenRequest rw mt a) where
              `hashWithSalt` ps
              `hashWithSalt` qs
              `hashWithSalt` l
-    hashWithSalt salt (PerPageQuery ps qs pp) =
-        salt `hashWithSalt` (2 :: Int)
-             `hashWithSalt` ps
-             `hashWithSalt` qs
-             `hashWithSalt` pp
     hashWithSalt salt (Command m ps body) =
         salt `hashWithSalt` (3 :: Int)
              `hashWithSalt` m
diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs
index afcfd47a..9cd7258f 100644
--- a/src/GitHub/Endpoints/Issues.hs
+++ b/src/GitHub/Endpoints/Issues.hs
@@ -8,7 +8,6 @@ module GitHub.Endpoints.Issues (
     organizationIssuesR,
     issueR,
     issuesForRepoR,
-    issuesForRepoPagedR,
     createIssueR,
     newIssue,
     editIssueR,
@@ -44,14 +43,6 @@ issuesForRepoR user reqRepoName opts =
   where
     qs = issueRepoModToQueryString opts
 
--- | List issues for a repository.
--- See <https://developer.github.com/v3/issues/#list-issues-for-a-repository>
-issuesForRepoPagedR :: Name Owner -> Name Repo -> IssueRepoMod -> PageParams -> Request k (Vector Issue, PageLinks)
-issuesForRepoPagedR user reqRepoName opts =
-    perPageQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs
-  where
-    qs = issueRepoModToQueryString opts
-
 -- Creating new issues.
 
 newIssue :: Text -> NewIssue
diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index 6453e94d..02165543 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -43,6 +43,7 @@ module GitHub.Request (
     QueryString,
     -- * Request execution in IO
     executeRequest,
+    executeRequestPaged,
     executeRequestWithMgr,
     executeRequestWithMgrAndRes,
     executeRequest',
@@ -202,6 +203,16 @@ executeRequest auth req = withOpenSSL $ do
     manager <- newManager tlsManagerSettings
     executeRequestWithMgr manager auth req
 
+executeRequestPaged
+    :: (AuthMethod am, ParseResponse mt a)
+    => am
+    -> PageParams
+    -> GenRequest mt rw a
+    -> IO (Either Error (a, PageLinks))
+executeRequestPaged auth pageParams req = withOpenSSL $ do
+    manager <- newManager tlsManagerSettings
+    executeRequestWithMgrPaged manager auth pageParams req
+
 lessFetchCount :: Int -> FetchCount -> Bool
 lessFetchCount _ FetchAll         = True
 lessFetchCount i (FetchAtLeast j) = i < fromIntegral j
@@ -217,6 +228,19 @@ executeRequestWithMgr
 executeRequestWithMgr mgr auth req =
     fmap (fmap responseBody) (executeRequestWithMgrAndRes mgr auth req)
 
+-- | Like 'executeRequest' but with provided 'Manager'.
+executeRequestWithMgrPaged
+    :: (AuthMethod am, ParseResponse mt a)
+    => Manager
+    -> am
+    -> PageParams
+    -> GenRequest mt rw a
+    -> IO (Either Error (a, PageLinks))
+executeRequestWithMgrPaged mgr auth pageParams req =
+    executeRequestWithMgrAndResPaged mgr auth pageParams req >>= \case
+        Left err -> return $ Left err
+        Right (res, links) -> return $ Right (responseBody res, links)
+
 -- | Execute request and return the last received 'HTTP.Response'.
 --
 -- @since 0.24
@@ -227,7 +251,7 @@ executeRequestWithMgrAndRes
     -> GenRequest mt rw a
     -> IO (Either Error (HTTP.Response a))
 executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
-    httpReq <- makeHttpRequest (Just auth) req
+    httpReq <- makeHttpRequest (Just auth) req []
     performHttpReq httpReq req
   where
     httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString)
@@ -238,21 +262,40 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
         res <- httpLbs' httpReq
         (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
 
+    performHttpReq httpReq (PagedQuery _ _ (FetchPage pp)) = do
+        (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
+        return res
+
     performHttpReq httpReq (PagedQuery _ _ l) =
         unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
       where
         predicate v = lessFetchCount (length v) l
 
-    performHttpReq httpReq (PerPageQuery _ _ _) = do
-        lift $ putStrLn "GOT HERE 1"
-        (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
-        lift $ putStrLn "GOT HERE 2"
-        pure res
-
     performHttpReq httpReq (Command _ _ _) = do
         res <- httpLbs' httpReq
         (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
 
+executeRequestWithMgrAndResPaged
+    :: (AuthMethod am, ParseResponse mt a)
+    => Manager
+    -> am
+    -> PageParams
+    -> GenRequest mt rw a
+    -> IO (Either Error (HTTP.Response a, PageLinks))
+executeRequestWithMgrAndResPaged mgr auth pp req = runExceptT $ do
+    httpReq <- makeHttpRequest (Just auth) req $ catMaybes [
+      (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
+      , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
+      ]
+    performHttpReq httpReq req
+  where
+    httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString)
+    httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException
+
+    performHttpReq :: forall rw mt b. (ParseResponse mt b) => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO (HTTP.Response b, PageLinks)
+    performHttpReq httpReq (PagedQuery _ _ _) =
+        unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
+
 -- | Like 'executeRequest' but without authentication.
 executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a)
 executeRequest' req = withOpenSSL $ do
@@ -457,30 +500,19 @@ makeHttpRequest
     :: forall am mt rw a m. (AuthMethod am, MonadThrow m, Accept mt)
     => Maybe am
     -> GenRequest mt rw a
+    -> [(BS.ByteString, Maybe BS.ByteString)]
     -> m HTTP.Request
-makeHttpRequest auth r = case r of
+makeHttpRequest auth r extraQueryItems = case r of
     Query paths qs -> do
         req <- parseUrl' $ url paths
         return
             $ setReqHeaders
             . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
             . maybe id setAuthRequest auth
-            . setQueryString qs
+            . setQueryString (qs <> extraQueryItems)
             $ req
     PagedQuery paths qs _ -> do
         req <- parseUrl' $ url paths
-        return
-            $ setReqHeaders
-            . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
-            . maybe id setAuthRequest auth
-            . setQueryString qs
-            $ req
-    PerPageQuery paths qs pp -> do
-        req <- parseUrl' $ url paths
-        let extraQueryItems = catMaybes [
-              (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
-              , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
-              ]
         return
             $ setReqHeaders
             . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
@@ -543,13 +575,16 @@ getNextUrl req = do
 --                     -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a)
 -- @
 performPagedRequest
-    :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m)
+    :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m, MonadIO m)
     => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
     -> (a -> Bool)                                         -- ^ predicate to continue iteration
     -> HTTP.Request                                        -- ^ initial request
     -> Tagged mt (m (HTTP.Response a))
 performPagedRequest httpLbs' predicate initReq = Tagged $ do
     res <- httpLbs' initReq
+
+    liftIO $ putStrLn ("performPagedRequest: Got res: " <> show res)
+
     m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
     go m res initReq
   where
@@ -585,9 +620,7 @@ performPerPageRequest httpLbs' initReq = Tagged $ do
     liftIO $ putStrLn ("performPerPageRequest: Got res: " <> show res)
 
     let links :: [Link URI] = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
-
     let linkToUri (Link uri _) = uri
-
     let pageLinks = PageLinks {
           pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
           , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links

From b6f3b3f8c0a46e718bd4b0cd4920b6c66682c20b Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:23:06 -0800
Subject: [PATCH 05/11] API is looking better, call this v2

---
 spec/GitHub/IssuesSpec.hs |   7 +--
 src/GitHub/Request.hs     | 113 ++++++++++----------------------------
 2 files changed, 32 insertions(+), 88 deletions(-)

diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs
index ffe574e5..4818f025 100644
--- a/spec/GitHub/IssuesSpec.hs
+++ b/spec/GitHub/IssuesSpec.hs
@@ -42,13 +42,12 @@ spec = do
 
     describe "issuesForRepoPagedR" $ do
         it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
-            cs <- GitHub.executeRequestPaged auth (PageParams (Just 2) (Just 1)) $
-                GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll
+            cs <- GitHub.executeRequest auth $
+                GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (PageParams (Just 2) (Just 1)))
             case cs of
               Left e ->
                 expectationFailure . show $ e
-              Right (cs', pageLinks) -> do
-                putStrLn ("GOT PAGE LINKS: " <> show pageLinks)
+              Right cs' -> do
                 for_ cs' $ \i -> do
                   cms <- GitHub.executeRequest auth $
                     GitHub.commentsR owner repo (GitHub.issueNumber i) 1
diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index 02165543..122675f9 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -43,7 +43,6 @@ module GitHub.Request (
     QueryString,
     -- * Request execution in IO
     executeRequest,
-    executeRequestPaged,
     executeRequestWithMgr,
     executeRequestWithMgrAndRes,
     executeRequest',
@@ -55,6 +54,7 @@ module GitHub.Request (
     ParseResponse (..),
     makeHttpRequest,
     parseStatus,
+    parsePageLinks,
     StatusMap,
     getNextUrl,
     performPagedRequest,
@@ -203,21 +203,6 @@ executeRequest auth req = withOpenSSL $ do
     manager <- newManager tlsManagerSettings
     executeRequestWithMgr manager auth req
 
-executeRequestPaged
-    :: (AuthMethod am, ParseResponse mt a)
-    => am
-    -> PageParams
-    -> GenRequest mt rw a
-    -> IO (Either Error (a, PageLinks))
-executeRequestPaged auth pageParams req = withOpenSSL $ do
-    manager <- newManager tlsManagerSettings
-    executeRequestWithMgrPaged manager auth pageParams req
-
-lessFetchCount :: Int -> FetchCount -> Bool
-lessFetchCount _ FetchAll         = True
-lessFetchCount i (FetchAtLeast j) = i < fromIntegral j
-
-
 -- | Like 'executeRequest' but with provided 'Manager'.
 executeRequestWithMgr
     :: (AuthMethod am, ParseResponse mt a)
@@ -228,19 +213,6 @@ executeRequestWithMgr
 executeRequestWithMgr mgr auth req =
     fmap (fmap responseBody) (executeRequestWithMgrAndRes mgr auth req)
 
--- | Like 'executeRequest' but with provided 'Manager'.
-executeRequestWithMgrPaged
-    :: (AuthMethod am, ParseResponse mt a)
-    => Manager
-    -> am
-    -> PageParams
-    -> GenRequest mt rw a
-    -> IO (Either Error (a, PageLinks))
-executeRequestWithMgrPaged mgr auth pageParams req =
-    executeRequestWithMgrAndResPaged mgr auth pageParams req >>= \case
-        Left err -> return $ Left err
-        Right (res, links) -> return $ Right (responseBody res, links)
-
 -- | Execute request and return the last received 'HTTP.Response'.
 --
 -- @since 0.24
@@ -251,7 +223,13 @@ executeRequestWithMgrAndRes
     -> GenRequest mt rw a
     -> IO (Either Error (HTTP.Response a))
 executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
-    httpReq <- makeHttpRequest (Just auth) req []
+    httpReq <- makeHttpRequest (Just auth) req $ case req of
+      PagedQuery _ _ (FetchPage pp) -> catMaybes [
+        (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
+        , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
+        ]
+      _ -> []
+
     performHttpReq httpReq req
   where
     httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString)
@@ -262,40 +240,18 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
         res <- httpLbs' httpReq
         (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
 
-    performHttpReq httpReq (PagedQuery _ _ (FetchPage pp)) = do
+    performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do
         (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
         return res
-
-    performHttpReq httpReq (PagedQuery _ _ l) =
-        unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
-      where
-        predicate v = lessFetchCount (length v) l
+    performHttpReq httpReq (PagedQuery _ _ FetchAll) =
+        unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
+    performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) =
+        unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
 
     performHttpReq httpReq (Command _ _ _) = do
         res <- httpLbs' httpReq
         (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
 
-executeRequestWithMgrAndResPaged
-    :: (AuthMethod am, ParseResponse mt a)
-    => Manager
-    -> am
-    -> PageParams
-    -> GenRequest mt rw a
-    -> IO (Either Error (HTTP.Response a, PageLinks))
-executeRequestWithMgrAndResPaged mgr auth pp req = runExceptT $ do
-    httpReq <- makeHttpRequest (Just auth) req $ catMaybes [
-      (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
-      , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
-      ]
-    performHttpReq httpReq req
-  where
-    httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString)
-    httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException
-
-    performHttpReq :: forall rw mt b. (ParseResponse mt b) => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO (HTTP.Response b, PageLinks)
-    performHttpReq httpReq (PagedQuery _ _ _) =
-        unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
-
 -- | Like 'executeRequest' but without authentication.
 executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a)
 executeRequest' req = withOpenSSL $ do
@@ -598,17 +554,9 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do
                 go (acc <> m) res' req'
             (_, _)           -> return (acc <$ res)
 
--- | Helper for making paginated requests. Responses, @a@ are combined monoidally.
---
--- The result is wrapped in the last received 'HTTP.Response'.
+-- | Helper for requesting a single page, as specified by 'PageParams'.
 --
--- @
--- performPerPageRequest :: ('FromJSON' a, 'Semigroup' a)
---                       => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' 'LBS.ByteString'))
---                       -> (a -> 'Bool')
---                       -> 'HTTP.Request'
---                       -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a)
--- @
+-- This parses and returns the 'PageLinks' alongside the HTTP response.
 performPerPageRequest
     :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m, MonadIO m)
     => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
@@ -616,25 +564,22 @@ performPerPageRequest
     -> Tagged mt (m (HTTP.Response a, PageLinks))
 performPerPageRequest httpLbs' initReq = Tagged $ do
     res <- httpLbs' initReq
-
-    liftIO $ putStrLn ("performPerPageRequest: Got res: " <> show res)
-
-    let links :: [Link URI] = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
-    let linkToUri (Link uri _) = uri
-    let pageLinks = PageLinks {
-          pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
-          , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
-          , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
-          , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
-          }
-
-    liftIO $ putStrLn ("performPerPageRequest: Got page links: " <> show pageLinks)
-
     m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
+    return (m <$ res, parsePageLinks res)
+
+-- | Parse the 'PageLinks' from an HTTP response, where the information is
+-- encoded in the Link header.
+parsePageLinks :: HTTP.Response a -> PageLinks
+parsePageLinks res = PageLinks {
+  pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
+  , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
+  , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
+  , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
+  }
+  where
+    links :: [Link URI] = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
+    linkToUri (Link uri _) = uri
 
-    liftIO $ putStrLn ("performPerPageRequest: Got here")
-
-    return (m <$ res, pageLinks)
 
 -------------------------------------------------------------------------------
 -- Internal

From c51f3b7440f2be9429f17e563e263c1d41e9f784 Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:28:48 -0800
Subject: [PATCH 06/11] Clean up some debugging stuff

---
 spec/GitHub/IssuesSpec.hs  |  5 ++++-
 src/GitHub/Data/Request.hs | 18 +++++++++---------
 src/GitHub/Request.hs      |  7 ++-----
 3 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs
index 4818f025..d8f8c72a 100644
--- a/spec/GitHub/IssuesSpec.hs
+++ b/spec/GitHub/IssuesSpec.hs
@@ -40,10 +40,13 @@ spec = do
                     GitHub.commentsR owner repo (GitHub.issueNumber i) 1
                   cms `shouldSatisfy` isRight
 
-    describe "issuesForRepoPagedR" $ do
+    describe "issuesForRepoR paged" $ do
         it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
             cs <- GitHub.executeRequest auth $
                 GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (PageParams (Just 2) (Just 1)))
+
+            length cs `shouldSatisfy` (<= 2)
+
             case cs of
               Left e ->
                 expectationFailure . show $ e
diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs
index a954ba0f..c9cc7a76 100644
--- a/src/GitHub/Data/Request.hs
+++ b/src/GitHub/Data/Request.hs
@@ -109,9 +109,9 @@ instance NFData FetchCount where rnf = genericRnf
 
 -- | Params for specifying the precise page and items per page.
 data PageParams = PageParams {
-  pageParamsPerPage :: Maybe Int
-  , pageParamsPage :: Maybe Int
-  }
+    pageParamsPerPage :: Maybe Int
+    , pageParamsPage :: Maybe Int
+    }
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 instance Hashable PageParams
@@ -125,11 +125,11 @@ instance NFData PageParams where rnf = genericRnf
 -- | 'PagedQuery' returns just some results, using this data we can specify how
 -- many pages we want to fetch.
 data PageLinks = PageLinks {
-  pageLinksPrev :: Maybe URI
-  , pageLinksNext :: Maybe URI
-  , pageLinksLast :: Maybe URI
-  , pageLinksFirst :: Maybe URI
-  }
+    pageLinksPrev :: Maybe URI
+    , pageLinksNext :: Maybe URI
+    , pageLinksLast :: Maybe URI
+    , pageLinksFirst :: Maybe URI
+    }
     deriving (Eq, Ord, Show, Generic, Typeable)
 
 instance NFData PageLinks where rnf = genericRnf
@@ -232,7 +232,7 @@ instance Hashable (GenRequest rw mt a) where
              `hashWithSalt` qs
              `hashWithSalt` l
     hashWithSalt salt (Command m ps body) =
-        salt `hashWithSalt` (3 :: Int)
+        salt `hashWithSalt` (2 :: Int)
              `hashWithSalt` m
              `hashWithSalt` ps
              `hashWithSalt` body
diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index 122675f9..1e6ed532 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -77,7 +77,6 @@ import Control.Monad.Error.Class (MonadError (..))
 import Control.Monad              (when)
 import Control.Monad.Catch        (MonadCatch (..), MonadThrow)
 import Control.Monad.Trans.Class  (lift)
-import Control.Monad.IO.Class     (MonadIO (..))
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Data.Aeson                 (eitherDecode)
 import Data.List                  (find)
@@ -531,7 +530,7 @@ getNextUrl req = do
 --                     -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a)
 -- @
 performPagedRequest
-    :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m, MonadIO m)
+    :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m)
     => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
     -> (a -> Bool)                                         -- ^ predicate to continue iteration
     -> HTTP.Request                                        -- ^ initial request
@@ -539,8 +538,6 @@ performPagedRequest
 performPagedRequest httpLbs' predicate initReq = Tagged $ do
     res <- httpLbs' initReq
 
-    liftIO $ putStrLn ("performPagedRequest: Got res: " <> show res)
-
     m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
     go m res initReq
   where
@@ -558,7 +555,7 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do
 --
 -- This parses and returns the 'PageLinks' alongside the HTTP response.
 performPerPageRequest
-    :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m, MonadIO m)
+    :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m)
     => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
     -> HTTP.Request                                        -- ^ initial request
     -> Tagged mt (m (HTTP.Response a, PageLinks))

From 7af0eb51199c980fb77a838845f4a731fdec2718 Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:32:26 -0800
Subject: [PATCH 07/11] More cleanup

---
 spec/GitHub/IssuesSpec.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs
index d8f8c72a..dba5d777 100644
--- a/spec/GitHub/IssuesSpec.hs
+++ b/spec/GitHub/IssuesSpec.hs
@@ -12,7 +12,6 @@ import Data.String        (fromString)
 import System.Environment (lookupEnv)
 import Test.Hspec
        (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
-import GitHub.Data.Request (PageParams(PageParams))
 
 fromRightS :: Show a => Either a b -> b
 fromRightS (Right b) = b
@@ -43,7 +42,7 @@ spec = do
     describe "issuesForRepoR paged" $ do
         it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
             cs <- GitHub.executeRequest auth $
-                GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (PageParams (Just 2) (Just 1)))
+                GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1)))
 
             length cs `shouldSatisfy` (<= 2)
 

From 87c3e33fd76252c13ab4501c7f7e13dba94b9188 Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:38:20 -0800
Subject: [PATCH 08/11] More cleanup

---
 src/GitHub/Request.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index 1e6ed532..8bfddd23 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -568,15 +568,17 @@ performPerPageRequest httpLbs' initReq = Tagged $ do
 -- encoded in the Link header.
 parsePageLinks :: HTTP.Response a -> PageLinks
 parsePageLinks res = PageLinks {
-  pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
-  , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
-  , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
-  , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
-  }
-  where
-    links :: [Link URI] = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
-    linkToUri (Link uri _) = uri
-
+    pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
+    , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
+    , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
+    , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
+    }
+    where
+        links :: [Link URI]
+        links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
+
+        linkToUri :: Link URI -> URI
+        linkToUri (Link uri _) = uri
 
 -------------------------------------------------------------------------------
 -- Internal

From d93ae32eef1525396d119821c3c4f0b9053b9cdb Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:41:25 -0800
Subject: [PATCH 09/11] Another slight refactor

---
 src/GitHub/Request.hs | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index 8bfddd23..d89a2c3e 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -222,13 +222,7 @@ executeRequestWithMgrAndRes
     -> GenRequest mt rw a
     -> IO (Either Error (HTTP.Response a))
 executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
-    httpReq <- makeHttpRequest (Just auth) req $ case req of
-      PagedQuery _ _ (FetchPage pp) -> catMaybes [
-        (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
-        , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
-        ]
-      _ -> []
-
+    httpReq <- makeHttpRequest (Just auth) req
     performHttpReq httpReq req
   where
     httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString)
@@ -455,9 +449,8 @@ makeHttpRequest
     :: forall am mt rw a m. (AuthMethod am, MonadThrow m, Accept mt)
     => Maybe am
     -> GenRequest mt rw a
-    -> [(BS.ByteString, Maybe BS.ByteString)]
     -> m HTTP.Request
-makeHttpRequest auth r extraQueryItems = case r of
+makeHttpRequest auth r = case r of
     Query paths qs -> do
         req <- parseUrl' $ url paths
         return
@@ -504,6 +497,14 @@ makeHttpRequest auth r extraQueryItems = case r of
     setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request
     setBody body req = req { requestBody = RequestBodyLBS body }
 
+    extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)]
+    extraQueryItems = case r of
+      PagedQuery _ _ (FetchPage pp) -> catMaybes [
+          (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
+          , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
+          ]
+      _ -> []
+
 -- | Query @Link@ header with @rel=next@ from the request headers.
 getNextUrl :: HTTP.Response a -> Maybe URI
 getNextUrl req = do

From 5c3da95413aec8b0e827b7a7b7b6efe447620b91 Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 17:43:26 -0800
Subject: [PATCH 10/11] Another cleanup

---
 src/GitHub/Request.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs
index d89a2c3e..332d1124 100644
--- a/src/GitHub/Request.hs
+++ b/src/GitHub/Request.hs
@@ -538,7 +538,6 @@ performPagedRequest
     -> Tagged mt (m (HTTP.Response a))
 performPagedRequest httpLbs' predicate initReq = Tagged $ do
     res <- httpLbs' initReq
-
     m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
     go m res initReq
   where

From cd32569e3b4572158ce240096a79633607b08e0a Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Tue, 27 Feb 2024 18:05:06 -0800
Subject: [PATCH 11/11] Improve test

---
 github.cabal              |  1 +
 spec/GitHub/IssuesSpec.hs | 27 +++++++++++++++------------
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/github.cabal b/github.cabal
index cde8b8ff..e4a906e5 100644
--- a/github.cabal
+++ b/github.cabal
@@ -268,6 +268,7 @@ test-suite github-test
     , file-embed
     , github
     , hspec                 >=2.6.1 && <2.12
+    , http-client
     , tagged
     , text
     , unordered-containers
diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs
index dba5d777..e673975f 100644
--- a/spec/GitHub/IssuesSpec.hs
+++ b/spec/GitHub/IssuesSpec.hs
@@ -6,12 +6,13 @@ import qualified GitHub
 import Prelude ()
 import Prelude.Compat
 
-import Data.Either.Compat (isRight)
-import Data.Foldable      (for_)
-import Data.String        (fromString)
-import System.Environment (lookupEnv)
-import Test.Hspec
-       (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
+import Data.Either.Compat  (isRight)
+import Data.Foldable       (for_)
+import Data.String         (fromString)
+import Network.HTTP.Client (newManager, responseBody)
+import System.Environment  (lookupEnv)
+import Test.Hspec          (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
+
 
 fromRightS :: Show a => Either a b -> b
 fromRightS (Right b) = b
@@ -41,16 +42,18 @@ spec = do
 
     describe "issuesForRepoR paged" $ do
         it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
-            cs <- GitHub.executeRequest auth $
+            mgr <- newManager GitHub.tlsManagerSettings
+            ret <- GitHub.executeRequestWithMgrAndRes mgr auth $
                 GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1)))
 
-            length cs `shouldSatisfy` (<= 2)
-
-            case cs of
+            case ret of
               Left e ->
                 expectationFailure . show $ e
-              Right cs' -> do
-                for_ cs' $ \i -> do
+              Right res -> do
+                let issues = responseBody res
+                length issues `shouldSatisfy` (<= 2)
+
+                for_ issues $ \i -> do
                   cms <- GitHub.executeRequest auth $
                     GitHub.commentsR owner repo (GitHub.issueNumber i) 1
                   cms `shouldSatisfy` isRight