{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : GitLab
-- Description : Contains the 'runGitLab' function to run GitLab actions
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab
  ( runGitLab,
    runGitLabDbg,
    runGitLabWithManager,
    module GitLab.Types,
    module GitLab.API.Pipelines,
    module GitLab.API.Groups,
    module GitLab.API.Members,
    module GitLab.API.Commits,
    module GitLab.API.Projects,
    module GitLab.API.Users,
    module GitLab.API.Issues,
    module GitLab.API.Branches,
    module GitLab.API.Jobs,
    module GitLab.API.MergeRequests,
    module GitLab.API.Repositories,
    module GitLab.API.RepositoryFiles,
    module GitLab.API.Tags,
    module GitLab.API.Todos,
    module GitLab.API.Version,
    module GitLab.API.Notes,
    module GitLab.API.Boards,
    module GitLab.API.Discussions,
    module GitLab.SystemHooks.GitLabSystemHooks,
    module GitLab.SystemHooks.Types,
    module GitLab.SystemHooks.Rules,
  )
where

import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import GitLab.API.Boards
import GitLab.API.Branches
import GitLab.API.Commits
import GitLab.API.Discussions
import GitLab.API.Groups
import GitLab.API.Issues
import GitLab.API.Jobs
import GitLab.API.Members
import GitLab.API.MergeRequests
import GitLab.API.Notes
import GitLab.API.Pipelines
import GitLab.API.Projects
import GitLab.API.Repositories
import GitLab.API.RepositoryFiles
import GitLab.API.Tags
import GitLab.API.Todos
import GitLab.API.Users
import GitLab.API.Version
import GitLab.SystemHooks.GitLabSystemHooks
import GitLab.SystemHooks.Rules
import GitLab.SystemHooks.Types
import GitLab.Types
import Network.Connection (TLSSettings (..))
import Network.HTTP.Conduit
import Network.HTTP.Types.Status
import System.IO

-- | runs a GitLab action.
--
-- Internally, this creates a single 'Manager', whichs keeps track of
-- open connections for keep-alive and which is shared between
-- multiple threads and requests.
--
-- An example of its use is:
--
-- > projectsWithIssuesEnabled :: IO [Project]
-- > projectsWithIssuesEnabled =
-- >   runGitLabyConfig $ filter (issueEnabled . issues_enabled) <$> allProjects
-- >   where
-- >     myConfig = defaultGitLabServer
-- >         { url = "https://gitlab.example.com"
-- >         , token = "my_access_token" }
-- >     issueEnabled Nothing = False
-- >     issueEnabled (Just b) = b
runGitLab :: GitLabServerConfig -> GitLab a -> IO a
runGitLab :: GitLabServerConfig -> GitLab a -> IO a
runGitLab GitLabServerConfig
cfg GitLab a
action = do
  IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
  let settings :: ManagerSettings
settings = TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings (Bool -> Bool -> Bool -> TLSSettings
TLSSettingsSimple Bool
True Bool
False Bool
False) Maybe SockSettings
forall a. Maybe a
Nothing
  Manager
manager <- IO Manager -> IO Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> IO Manager) -> IO Manager -> IO Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
settings
  Manager -> GitLabServerConfig -> GitLab a -> IO a
forall a. Manager -> GitLabServerConfig -> GitLab a -> IO a
runGitLabWithManager Manager
manager GitLabServerConfig
cfg GitLab a
action

-- | The same as 'runGitLab', except that it also takes a connection
-- manager as an argument.
runGitLabWithManager :: Manager -> GitLabServerConfig -> GitLab a -> IO a
runGitLabWithManager :: Manager -> GitLabServerConfig -> GitLab a -> IO a
runGitLabWithManager Manager
manager GitLabServerConfig
cfg GitLab a
action = do
  -- test the token access
  Either (Response ByteString) (Maybe Version)
tokenTest <- ReaderT
  GitLabState IO (Either (Response ByteString) (Maybe Version))
-> GitLabState -> IO (Either (Response ByteString) (Maybe Version))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  GitLabState IO (Either (Response ByteString) (Maybe Version))
gitlabVersion (GitLabServerConfig -> Manager -> GitLabState
GitLabState GitLabServerConfig
cfg Manager
manager)
  case Either (Response ByteString) (Maybe Version)
tokenTest of
    Left Response ByteString
response ->
      case Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response of
        (Status Int
401 ByteString
"Unauthorized") -> [Char] -> IO a
forall a. HasCallStack => [Char] -> a
error [Char]
"access token not accepted."
        Status
st -> [Char] -> IO a
forall a. HasCallStack => [Char] -> a
error ([Char]
"unexpected HTTP status: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Status -> [Char]
forall a. Show a => a -> [Char]
show Status
st)
    Right Maybe Version
_versionInfo ->
      -- it worked, run the user code.
      GitLab a -> GitLabState -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GitLab a
action (GitLabServerConfig -> Manager -> GitLabState
GitLabState GitLabServerConfig
cfg Manager
manager)

-- | Only useful for testing GitLab actions that lift IO actions with
-- liftIO. Cannot speak to a GitLab server. Only useful for the
-- gitlab-haskell tests.
runGitLabDbg :: GitLab a -> IO a
runGitLabDbg :: GitLab a -> IO a
runGitLabDbg GitLab a
action = do
  IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
  GitLab a -> GitLabState -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GitLab a
action GitLabState
forall a. HasCallStack => a
undefined