module Gitlab.Core
( HasGitlabConfig(..)
, GitlabConfig(..)
, MonadGitlab
, gitlabRequest
, rParam
)
where
import Data.Yaml
import Network.HTTP.Simple
import Network.HTTP.Conduit
import Network.HTTP.Types
import RIO
import qualified RIO.Text as Text
class HasGitlabConfig a where
gitlabConfigL :: Lens' a GitlabConfig
data GitlabConfig = GitlabConfig {
glBaseUrl :: Text
, glToken :: Text
} deriving (Eq, Show)
instance HasGitlabConfig GitlabConfig where
gitlabConfigL = id
type MonadGitlab env m = (MonadReader env m, HasGitlabConfig env, MonadIO m, MonadThrow m)
gitlabRequest
:: (MonadGitlab env m, FromJSON a)
=> ByteString
-> ByteString
-> RequestBody
-> m a
gitlabRequest method path body = do
conf <- ask . view $ gitlabConfigL
request' <- parseRequest $ Text.unpack $ glBaseUrl conf
let headers =
[ ("PRIVATE-TOKEN", fromString . Text.unpack $ glToken conf)
, ("Content-Type" , "application/json; charset=utf-8")
]
let request =
setRequestMethod method
$ setRequestPath ("/api/v4" <> path)
$ setRequestHeaders headers
$ setRequestBody body request'
response <- httpJSON request
return $ getResponseBody response
rParam x = urlEncode False (fromString . Text.unpack $ x)