{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | internal module to support modules in GitLab.API
module GitLab.WebRequests.GitLabWebCalls
  ( gitlab,
    gitlabUnsafe,
    gitlabWithAttrs,
    gitlabWithAttrsUnsafe,
    gitlabOne,
    -- gitlabOneIO,
    gitlabWithAttrsOne,
    -- not currently used.
    -- gitlabWithAttrsOneUnsafe,
    gitlabPost,
    gitlabPut,
    gitlabDelete,
    gitlabReqText,
    gitlabReqByteString,
  )
where

import qualified Control.Exception as Exception
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Lazy.Char8 as C
import Data.Either
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GitLab.Types
import Network.HTTP.Conduit
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI
import Text.Read

newtype GitLabException = GitLabException String
  deriving (GitLabException -> GitLabException -> Bool
(GitLabException -> GitLabException -> Bool)
-> (GitLabException -> GitLabException -> Bool)
-> Eq GitLabException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitLabException -> GitLabException -> Bool
$c/= :: GitLabException -> GitLabException -> Bool
== :: GitLabException -> GitLabException -> Bool
$c== :: GitLabException -> GitLabException -> Bool
Eq, Int -> GitLabException -> ShowS
[GitLabException] -> ShowS
GitLabException -> String
(Int -> GitLabException -> ShowS)
-> (GitLabException -> String)
-> ([GitLabException] -> ShowS)
-> Show GitLabException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitLabException] -> ShowS
$cshowList :: [GitLabException] -> ShowS
show :: GitLabException -> String
$cshow :: GitLabException -> String
showsPrec :: Int -> GitLabException -> ShowS
$cshowsPrec :: Int -> GitLabException -> ShowS
Show)

instance Exception.Exception GitLabException

-- In this module, "unsafe" functions are those that discard HTTP
-- error code responses, e.g. 404, 409.

gitlabPost ::
  (FromJSON b) =>
  -- | the URL to post to
  Text ->
  -- | the data to post
  Text ->
  GitLab (Either Status (Maybe b))
gitlabPost :: Text -> Text -> GitLab (Either Status (Maybe b))
gitlabPost Text
urlPath Text
dataBody = do
  GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg (GitLabState -> GitLabServerConfig)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO GitLabServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Manager
manager <- GitLabState -> Manager
httpManager (GitLabState -> Manager)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let url' :: Text
url' = GitLabServerConfig -> Text
url GitLabServerConfig
cfg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/api/v4" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlPath
  let request' :: Request
request' = String -> Request
parseRequest_ (Text -> String
T.unpack Text
url')
      request :: Request
request =
        Request
request'
          { method :: Method
method = Method
"POST",
            requestHeaders :: RequestHeaders
requestHeaders =
              [(HeaderName
"PRIVATE-TOKEN", Text -> Method
T.encodeUtf8 (GitLabServerConfig -> Text
token GitLabServerConfig
cfg))],
            requestBody :: RequestBody
requestBody = Method -> RequestBody
RequestBodyBS (Text -> Method
T.encodeUtf8 Text
dataBody)
          }
  Response ByteString
resp <- IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT GitLabState IO (Response ByteString))
-> IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab Int
0 Request
request (GitLabServerConfig -> Int
retries GitLabServerConfig
cfg) Manager
manager Maybe HttpException
forall a. Maybe a
Nothing
  if Status -> Bool
successStatus (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp)
    then
      Either Status (Maybe b) -> GitLab (Either Status (Maybe b))
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( case ByteString -> Maybe b
forall a. FromJSON a => ByteString -> Maybe a
parseBSOne (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp) of
            Just b
x -> Maybe b -> Either Status (Maybe b)
forall a b. b -> Either a b
Right (b -> Maybe b
forall a. a -> Maybe a
Just b
x)
            Maybe b
Nothing -> Maybe b -> Either Status (Maybe b)
forall a b. b -> Either a b
Right Maybe b
forall a. Maybe a
Nothing
            -- Nothing ->
            --   Left $
            --     mkStatus 409 "unable to parse POST response"
        )
    else Either Status (Maybe b) -> GitLab (Either Status (Maybe b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Either Status (Maybe b)
forall a b. a -> Either a b
Left (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp))

gitlabPut ::
  FromJSON b =>
  -- | the URL to post to
  Text ->
  -- | the data to post
  Text ->
  GitLab (Either Status b)
gitlabPut :: Text -> Text -> GitLab (Either Status b)
gitlabPut Text
urlPath Text
dataBody = do
  GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg (GitLabState -> GitLabServerConfig)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO GitLabServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Manager
manager <- GitLabState -> Manager
httpManager (GitLabState -> Manager)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let url' :: Text
url' = GitLabServerConfig -> Text
url GitLabServerConfig
cfg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/api/v4" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlPath
  let request' :: Request
request' = String -> Request
parseRequest_ (Text -> String
T.unpack Text
url')
      request :: Request
request =
        Request
request'
          { method :: Method
method = Method
"PUT",
            requestHeaders :: RequestHeaders
requestHeaders =
              [ (HeaderName
"PRIVATE-TOKEN", Text -> Method
T.encodeUtf8 (GitLabServerConfig -> Text
token GitLabServerConfig
cfg)),
                (HeaderName
"content-type", Method
"application/json")
              ],
            requestBody :: RequestBody
requestBody = Method -> RequestBody
RequestBodyBS (Text -> Method
T.encodeUtf8 Text
dataBody)
          }
  Response ByteString
resp <- IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT GitLabState IO (Response ByteString))
-> IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab Int
0 Request
request (GitLabServerConfig -> Int
retries GitLabServerConfig
cfg) Manager
manager Maybe HttpException
forall a. Maybe a
Nothing
  if Status -> Bool
successStatus (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp)
    then
      Either Status b -> GitLab (Either Status b)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( case ByteString -> Maybe b
forall a. FromJSON a => ByteString -> Maybe a
parseBSOne (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp) of
            Just b
x -> b -> Either Status b
forall a b. b -> Either a b
Right b
x
            Maybe b
Nothing ->
              Status -> Either Status b
forall a b. a -> Either a b
Left (Status -> Either Status b) -> Status -> Either Status b
forall a b. (a -> b) -> a -> b
$
                Int -> Method -> Status
mkStatus Int
409 Method
"unable to parse PUT response"
        )
    else Either Status b -> GitLab (Either Status b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Either Status b
forall a b. a -> Either a b
Left (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp))

gitlabDelete ::
  -- | the URL to post to
  Text ->
  GitLab (Either Status ())
gitlabDelete :: Text -> GitLab (Either Status ())
gitlabDelete Text
urlPath = do
  GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg (GitLabState -> GitLabServerConfig)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO GitLabServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Manager
manager <- GitLabState -> Manager
httpManager (GitLabState -> Manager)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let url' :: Text
url' = GitLabServerConfig -> Text
url GitLabServerConfig
cfg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/api/v4" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlPath
  let request' :: Request
request' = String -> Request
parseRequest_ (Text -> String
T.unpack Text
url')
      request :: Request
request =
        Request
request'
          { method :: Method
method = Method
"DELETE",
            requestHeaders :: RequestHeaders
requestHeaders =
              [ (HeaderName
"PRIVATE-TOKEN", Text -> Method
T.encodeUtf8 (GitLabServerConfig -> Text
token GitLabServerConfig
cfg)),
                (HeaderName
"content-type", Method
"application/json")
              ],
            requestBody :: RequestBody
requestBody = Method -> RequestBody
RequestBodyBS Method
BS.empty
          }
  Response ByteString
resp <- IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT GitLabState IO (Response ByteString))
-> IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab Int
0 Request
request (GitLabServerConfig -> Int
retries GitLabServerConfig
cfg) Manager
manager Maybe HttpException
forall a. Maybe a
Nothing
  if Status -> Bool
successStatus (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp)
    then Either Status () -> GitLab (Either Status ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Status ()
forall a b. b -> Either a b
Right ())
    else Either Status () -> GitLab (Either Status ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Either Status ()
forall a b. a -> Either a b
Left (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp))

tryGitLab ::
  -- | the current retry count
  Int ->
  -- | the GitLab request
  Request ->
  -- | maximum number of retries permitted
  Int ->
  -- | HTTP manager
  Manager ->
  -- | the exception to report if maximum retries met
  Maybe HttpException ->
  IO (Response BSL.ByteString)
tryGitLab :: Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab Int
i Request
request Int
maxRetries Manager
manager Maybe HttpException
lastException
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxRetries = String -> IO (Response ByteString)
forall a. HasCallStack => String -> a
error (Maybe HttpException -> String
forall a. Show a => a -> String
show Maybe HttpException
lastException)
  | Bool
otherwise =
    Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
request Manager
manager
      IO (Response ByteString)
-> (HttpException -> IO (Response ByteString))
-> IO (Response ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exception.catch` \HttpException
ex -> Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Request
request Int
maxRetries Manager
manager (HttpException -> Maybe HttpException
forall a. a -> Maybe a
Just HttpException
ex)

parseBSOne :: FromJSON a => BSL.ByteString -> Maybe a
parseBSOne :: ByteString -> Maybe a
parseBSOne ByteString
bs =
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs of
    Left String
_err -> Maybe a
forall a. Maybe a
Nothing
    -- useful when debugging
    Right a
xs -> a -> Maybe a
forall a. a -> Maybe a
Just a
xs

parseBSMany :: FromJSON a => BSL.ByteString -> IO [a]
parseBSMany :: ByteString -> IO [a]
parseBSMany ByteString
bs =
  case ByteString -> Either String [a]
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs of
    Left String
s -> GitLabException -> IO [a]
forall e a. Exception e => e -> IO a
Exception.throwIO (GitLabException -> IO [a]) -> GitLabException -> IO [a]
forall a b. (a -> b) -> a -> b
$ String -> GitLabException
GitLabException String
s
    Right [a]
xs -> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs

gitlabReqJsonMany :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a])
gitlabReqJsonMany :: Text -> Text -> GitLab (Either Status [a])
gitlabReqJsonMany Text
urlPath Text
attrs =
  Int -> [a] -> GitLab (Either Status [a])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Int -> [a] -> ReaderT GitLabState m (Either Status [a])
go Int
1 []
  where
    go :: Int -> [a] -> ReaderT GitLabState m (Either Status [a])
go Int
i [a]
accum = do
      GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg (GitLabState -> GitLabServerConfig)
-> ReaderT GitLabState m GitLabState
-> ReaderT GitLabState m GitLabServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState m GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      Manager
manager <- GitLabState -> Manager
httpManager (GitLabState -> Manager)
-> ReaderT GitLabState m GitLabState
-> ReaderT GitLabState m Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState m GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      let url' :: Text
url' =
            GitLabServerConfig -> Text
url GitLabServerConfig
cfg
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/api/v4"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlPath
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?per_page=100"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&page="
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Method -> Text
T.decodeUtf8 (Bool -> Method -> Method
urlEncode Bool
False (Text -> Method
T.encodeUtf8 Text
attrs))
      let request' :: Request
request' = String -> Request
parseRequest_ (Text -> String
T.unpack Text
url')
          request :: Request
request =
            Request
request'
              { requestHeaders :: RequestHeaders
requestHeaders =
                  [(HeaderName
"PRIVATE-TOKEN", Text -> Method
T.encodeUtf8 (GitLabServerConfig -> Text
token GitLabServerConfig
cfg))],
                responseTimeout :: ResponseTimeout
responseTimeout = Int -> ResponseTimeout
responseTimeoutMicro (GitLabServerConfig -> Int
timeout GitLabServerConfig
cfg)
              }
      Response ByteString
resp <- IO (Response ByteString)
-> ReaderT GitLabState m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT GitLabState m (Response ByteString))
-> IO (Response ByteString)
-> ReaderT GitLabState m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab Int
0 Request
request (GitLabServerConfig -> Int
retries GitLabServerConfig
cfg) Manager
manager Maybe HttpException
forall a. Maybe a
Nothing
      if Status -> Bool
successStatus (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp)
        then do
          [a]
moreResults <- IO [a] -> ReaderT GitLabState m [a]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> ReaderT GitLabState m [a])
-> IO [a] -> ReaderT GitLabState m [a]
forall a b. (a -> b) -> a -> b
$ ByteString -> IO [a]
forall a. FromJSON a => ByteString -> IO [a]
parseBSMany (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp)
          let numPages :: Int
numPages = Response ByteString -> Int
forall a. Response a -> Int
totalPages Response ByteString
resp
              accum' :: [a]
accum' = [a]
accum [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
moreResults
          if Int
numPages Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
            then Either Status [a] -> ReaderT GitLabState m (Either Status [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Either Status [a]
forall a b. b -> Either a b
Right [a]
accum')
            else Int -> [a] -> ReaderT GitLabState m (Either Status [a])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
accum'
        else Either Status [a] -> ReaderT GitLabState m (Either Status [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Either Status [a]
forall a b. a -> Either a b
Left (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp))

-- not sure what this was planned for
--
-- gitlabReqOneIO :: Manager -> GitLabServerConfig -> (BSL.ByteString -> output) -> Text -> Text -> IO (Either Status output)
-- gitlabReqOneIO manager cfg parser urlPath attrs = go
--   where
--     go = do
--       let url' =
--             url cfg
--               <> "/api/v4"
--               <> urlPath
--               <> "?per_page=100"
--               <> "&page=1"
--               <> attrs
--       let request' = parseRequest_ (T.unpack url')
--           request =
--             request'
--               { requestHeaders =
--                   [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],
--                 responseTimeout = responseTimeoutMicro (timeout cfg)
--               }
--       resp <- tryGitLab 0 request (retries cfg) manager Nothing
--       if successStatus (responseStatus resp)
--         then return (Right (parser (responseBody resp)))
--         else return (Left (responseStatus resp))

gitlabReqOne :: (BSL.ByteString -> output) -> Text -> Text -> GitLab (Either Status output)
gitlabReqOne :: (ByteString -> output)
-> Text -> Text -> GitLab (Either Status output)
gitlabReqOne ByteString -> output
parser Text
urlPath Text
attrs = GitLab (Either Status output)
go
  where
    go :: GitLab (Either Status output)
go = do
      GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg (GitLabState -> GitLabServerConfig)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO GitLabServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      Manager
manager <- GitLabState -> Manager
httpManager (GitLabState -> Manager)
-> ReaderT GitLabState IO GitLabState
-> ReaderT GitLabState IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT GitLabState IO GitLabState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      let url' :: Text
url' =
            GitLabServerConfig -> Text
url GitLabServerConfig
cfg
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/api/v4"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
urlPath
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?per_page=100"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&page=1"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrs
      let request' :: Request
request' = String -> Request
parseRequest_ (Text -> String
T.unpack Text
url')
          request :: Request
request =
            Request
request'
              { requestHeaders :: RequestHeaders
requestHeaders =
                  [(HeaderName
"PRIVATE-TOKEN", Text -> Method
T.encodeUtf8 (GitLabServerConfig -> Text
token GitLabServerConfig
cfg))],
                responseTimeout :: ResponseTimeout
responseTimeout = Int -> ResponseTimeout
responseTimeoutMicro (GitLabServerConfig -> Int
timeout GitLabServerConfig
cfg)
              }
      Response ByteString
resp <- IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ReaderT GitLabState IO (Response ByteString))
-> IO (Response ByteString)
-> ReaderT GitLabState IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> Request
-> Int
-> Manager
-> Maybe HttpException
-> IO (Response ByteString)
tryGitLab Int
0 Request
request (GitLabServerConfig -> Int
retries GitLabServerConfig
cfg) Manager
manager Maybe HttpException
forall a. Maybe a
Nothing
      if Status -> Bool
successStatus (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp)
        then Either Status output -> GitLab (Either Status output)
forall (m :: * -> *) a. Monad m => a -> m a
return (output -> Either Status output
forall a b. b -> Either a b
Right (ByteString -> output
parser (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp)))
        else Either Status output -> GitLab (Either Status output)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Either Status output
forall a b. a -> Either a b
Left (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp))

-- not sure what this was planned for
--
-- gitlabReqJsonOneIO :: (FromJSON a) => Manager -> GitLabServerConfig -> Text -> Text -> IO (Either Status (Maybe a))
-- gitlabReqJsonOneIO mgr cfg urlPath attrs =
--   gitlabReqOneIO mgr cfg parseBSOne urlPath attrs

gitlabReqJsonOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a))
gitlabReqJsonOne :: Text -> Text -> GitLab (Either Status (Maybe a))
gitlabReqJsonOne =
  (ByteString -> Maybe a)
-> Text -> Text -> GitLab (Either Status (Maybe a))
forall output.
(ByteString -> output)
-> Text -> Text -> GitLab (Either Status output)
gitlabReqOne ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
parseBSOne

gitlabReqText :: Text -> GitLab (Either Status String)
gitlabReqText :: Text -> GitLab (Either Status String)
gitlabReqText Text
urlPath = (ByteString -> String)
-> Text -> Text -> GitLab (Either Status String)
forall output.
(ByteString -> output)
-> Text -> Text -> GitLab (Either Status output)
gitlabReqOne ByteString -> String
C.unpack Text
urlPath Text
""

gitlabReqByteString :: Text -> GitLab (Either Status BSL.ByteString)
gitlabReqByteString :: Text -> GitLab (Either Status ByteString)
gitlabReqByteString Text
urlPath = (ByteString -> ByteString)
-> Text -> Text -> GitLab (Either Status ByteString)
forall output.
(ByteString -> output)
-> Text -> Text -> GitLab (Either Status output)
gitlabReqOne ByteString -> ByteString
forall a. a -> a
Prelude.id Text
urlPath Text
""

gitlab :: FromJSON a => Text -> GitLab (Either Status [a])
gitlab :: Text -> GitLab (Either Status [a])
gitlab Text
addr = Text -> Text -> GitLab (Either Status [a])
forall a. FromJSON a => Text -> Text -> GitLab (Either Status [a])
gitlabReqJsonMany Text
addr Text
""

gitlabUnsafe :: (FromJSON a) => Text -> GitLab [a]
gitlabUnsafe :: Text -> GitLab [a]
gitlabUnsafe Text
addr =
  [a] -> Either Status [a] -> [a]
forall b a. b -> Either a b -> b
fromRight (String -> [a]
forall a. HasCallStack => String -> a
error String
"gitlabUnsafe error") (Either Status [a] -> [a])
-> ReaderT GitLabState IO (Either Status [a]) -> GitLab [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ReaderT GitLabState IO (Either Status [a])
forall a. FromJSON a => Text -> GitLab (Either Status [a])
gitlab Text
addr

-- not sure what this was planned for
--
-- gitlabOneIO :: (FromJSON a) => Manager -> GitLabServerConfig -> Text -> IO (Either Status (Maybe a))
-- gitlabOneIO mgr cfg addr = gitlabReqJsonOneIO mgr cfg addr ""

gitlabOne :: (FromJSON a) => Text -> GitLab (Either Status (Maybe a))
gitlabOne :: Text -> GitLab (Either Status (Maybe a))
gitlabOne Text
addr = Text -> Text -> GitLab (Either Status (Maybe a))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either Status (Maybe a))
gitlabReqJsonOne Text
addr Text
""

gitlabWithAttrs :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a])
gitlabWithAttrs :: Text -> Text -> GitLab (Either Status [a])
gitlabWithAttrs = Text -> Text -> GitLab (Either Status [a])
forall a. FromJSON a => Text -> Text -> GitLab (Either Status [a])
gitlabReqJsonMany

gitlabWithAttrsUnsafe :: (FromJSON a) => Text -> Text -> GitLab [a]
gitlabWithAttrsUnsafe :: Text -> Text -> GitLab [a]
gitlabWithAttrsUnsafe Text
gitlabURL Text
attrs =
  [a] -> Either Status [a] -> [a]
forall b a. b -> Either a b -> b
fromRight (String -> [a]
forall a. HasCallStack => String -> a
error String
"gitlabWithAttrsUnsafe error") (Either Status [a] -> [a])
-> ReaderT GitLabState IO (Either Status [a]) -> GitLab [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ReaderT GitLabState IO (Either Status [a])
forall a. FromJSON a => Text -> Text -> GitLab (Either Status [a])
gitlabReqJsonMany Text
gitlabURL Text
attrs

gitlabWithAttrsOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a))
gitlabWithAttrsOne :: Text -> Text -> GitLab (Either Status (Maybe a))
gitlabWithAttrsOne = Text -> Text -> GitLab (Either Status (Maybe a))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either Status (Maybe a))
gitlabReqJsonOne

-- not currently used.
-- gitlabWithAttrsOneUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab (Maybe a)
-- gitlabWithAttrsOneUnsafe gitlabURL attrs =
--   fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonOne gitlabURL attrs

totalPages :: Response a -> Int
totalPages :: Response a -> Int
totalPages Response a
resp =
  let hdrs :: RequestHeaders
hdrs = Response a -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response a
resp
   in RequestHeaders -> Int
forall p a. (Num p, Eq a, IsString a, Read p) => [(a, Method)] -> p
findPages RequestHeaders
hdrs
  where
    findPages :: [(a, Method)] -> p
findPages [] = p
1 -- error "cannot find X-Total-Pages in header"
    findPages ((a
"X-Total-Pages", Method
bs) : [(a, Method)]
_) =
      case String -> Maybe p
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack (Method -> Text
T.decodeUtf8 Method
bs)) of
        Just p
s -> p
s
        Maybe p
Nothing -> String -> p
forall a. HasCallStack => String -> a
error String
"cannot find X-Total-Pages in header"
    findPages ((a, Method)
_ : [(a, Method)]
xs) = [(a, Method)] -> p
findPages [(a, Method)]
xs

successStatus :: Status -> Bool
successStatus :: Status -> Bool
successStatus (Status Int
n Method
_msg) =
  Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
226