{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : GitLab.SystemHooks.Rules
-- Description : Common GitLab system hook rules
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.SystemHooks.Rules (ruleAddMembers, ruleAddNewUserToGroups) where

import Control.Monad
import Data.Text
import GitLab.API.Groups
import GitLab.API.Members
import GitLab.API.Projects
import GitLab.API.Users
import GitLab.SystemHooks.Types
import GitLab.Types

ruleAddNewUserToGroups ::
  -- | rule label
  String ->
  -- | list of (non registered) usernames
  [Text] ->
  -- | list of groups to add new user to
  [Text] ->
  Rule
ruleAddNewUserToGroups :: String -> [Text] -> [Text] -> Rule
ruleAddNewUserToGroups String
lbl [Text]
nonRegisteredUsernames [Text]
groupNames =
  String
-> (UserCreate -> GitLab Bool) -> (UserCreate -> GitLab ()) -> Rule
forall a.
SystemHook a =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
matchIf
    String
lbl
    ( \event :: UserCreate
event@UserCreate {} -> do
        Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (UserCreate -> Text
userCreate_username UserCreate
event Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
nonRegisteredUsernames)
    )
    ( \event :: UserCreate
event@UserCreate {} -> do
        (Text
 -> ReaderT
      GitLabState IO (Either (Response ByteString) (Maybe Member)))
-> [Text] -> GitLab ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
          ( \Text
groupName ->
              -- will return value of type `Left Status` if user already
              -- member of the group, `void` silently ignores any outcome.
              Text
-> AccessLevel
-> Int
-> ReaderT
     GitLabState IO (Either (Response ByteString) (Maybe Member))
addUserToGroup' Text
groupName AccessLevel
Reporter (UserCreate -> Int
userCreate_user_id UserCreate
event)
          )
          [Text]
groupNames
    )

ruleAddMembers ::
  -- | rule label
  String ->
  -- | project names to match on
  [Text] ->
  -- | user names to add as member of matched project
  [Text] ->
  Rule
ruleAddMembers :: String -> [Text] -> [Text] -> Rule
ruleAddMembers String
label [Text]
projectNames [Text]
userNames =
  String
-> (ProjectCreate -> GitLab Bool)
-> (ProjectCreate -> GitLab ())
-> Rule
forall a.
SystemHook a =>
String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule
matchIf
    String
label
    ( \event :: ProjectCreate
event@ProjectCreate {} -> do
        Either (Response ByteString) (Maybe Project)
request <- Int -> GitLab (Either (Response ByteString) (Maybe Project))
searchProjectId (ProjectCreate -> Int
projectCreate_project_id ProjectCreate
event)
        case Either (Response ByteString) (Maybe Project)
request of
          Left Response ByteString
_ -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          Right Maybe Project
Nothing -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          Right (Just Project
prj) ->
            Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
              ( Project -> Text
project_path Project
prj
                  Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
projectNames
              )
    )
    ( \event :: ProjectCreate
event@ProjectCreate {} -> do
        (Text -> GitLab ()) -> [Text] -> GitLab ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
          ( \Text
userName -> do
              Maybe User
request <- Text -> GitLab (Maybe User)
searchUser Text
userName
              case Maybe User
request of
                Maybe User
Nothing -> () -> GitLab ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just User
foundUser ->
                  ReaderT
  GitLabState IO (Either (Response ByteString) (Maybe Member))
-> GitLab ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT
   GitLabState IO (Either (Response ByteString) (Maybe Member))
 -> GitLab ())
-> ReaderT
     GitLabState IO (Either (Response ByteString) (Maybe Member))
-> GitLab ()
forall a b. (a -> b) -> a -> b
$
                    Int
-> AccessLevel
-> Int
-> ReaderT
     GitLabState IO (Either (Response ByteString) (Maybe Member))
addMemberToProject'
                      (ProjectCreate -> Int
projectCreate_project_id ProjectCreate
event)
                      AccessLevel
Reporter
                      (User -> Int
user_id User
foundUser)
          )
          [Text]
userNames
    )