----------------------------------------------------------------------------- -- | -- Module : Gitlab.Core -- Copyright : (c) Daniel Firth 2018 -- License : BSD3 -- Maintainer : locallycompact@gmail.com -- Stability : experimental -- -- This file defines general functions for interacting with the Gitlab V4 API -- (https://docs.gitlab.com/ce/api/) -- ----------------------------------------------------------------------------- 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)