{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GitLab.WebRequests.GitLabWebCalls
( gitlab,
gitlabUnsafe,
gitlabOneUnsafe,
gitlabWithAttrs,
gitlabWithAttrsUnsafe,
gitlabOne,
gitlabWithAttrsOne,
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 qualified 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
gitlabPost ::
(FromJSON b) =>
Text ->
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
)
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 =>
Text ->
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 ::
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 ::
Int ->
Request ->
Int ->
Manager ->
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
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))
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))
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
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
""
gitlabOneUnsafe :: (FromJSON a) => Text -> GitLab a
gitlabOneUnsafe :: Text -> GitLab a
gitlabOneUnsafe Text
addr = do
Maybe a
result <- Maybe a -> Either Status (Maybe a) -> Maybe a
forall b a. b -> Either a b -> b
fromRight (String -> Maybe a
forall a. HasCallStack => String -> a
error String
"gitlabOneUnsafe error") (Either Status (Maybe a) -> Maybe a)
-> ReaderT GitLabState IO (Either Status (Maybe a))
-> ReaderT GitLabState IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ReaderT GitLabState IO (Either Status (Maybe a))
forall a. FromJSON a => Text -> GitLab (Either Status (Maybe a))
gitlabOne Text
addr
case Maybe a
result of
Maybe a
Nothing -> String -> GitLab a
forall a. HasCallStack => String -> a
error String
"gitlabOneUnsafe error"
Just a
value -> a -> GitLab a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value
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
gitlabWithAttrsOneUnsafe :: (FromJSON a) => Text -> Text -> GitLab a
gitlabWithAttrsOneUnsafe :: Text -> Text -> GitLab a
gitlabWithAttrsOneUnsafe Text
gitlabURL Text
attrs = do
Either Status (Maybe a)
result <- Text -> Text -> GitLab (Either Status (Maybe a))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either Status (Maybe a))
gitlabReqJsonOne Text
gitlabURL Text
attrs
case Either Status (Maybe a)
result of
Left Status
s -> String -> GitLab a
forall a. HasCallStack => String -> a
error (String
"gitlabWithAttrsOneUnsafe: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Status -> String
forall a. Show a => a -> String
show Status
s)
Right Maybe a
Nothing -> String -> GitLab a
forall a. HasCallStack => String -> a
error (String
"gitlabWithAttrsOneUnsafe: could not parse JSON for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
attrs)
Right (Just a
x) -> a -> GitLab a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
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
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