{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

-- |
-- Module      : GitLab.API.Events
-- Description : Queries for GitLab Events API
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
--
-- See <https://docs.gitlab.com/ee/api/events.html>
module GitLab.API.Events
  ( -- * Authenticated user events
    currentUserEvents,

    -- * User events
    userEvents,
    userEvents',

    -- * Project events
    projectEvents,
    projectEvents',

    -- * Group events
    groupEvents,
    groupEvents',

    -- * Filter attributes
    EventFilterAttrs (..),
    defaultEventFilters,
  )
where

import Control.Monad.Except
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import Data.Time.Format.ISO8601
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client

-- | Filter attributes for event queries.
--
-- Use 'defaultEventFilters' as a starting point and override fields as needed.
data EventFilterAttrs = EventFilterAttrs
  { -- | Filter by action name (e.g. 'ANOpened', 'ANMerged', 'ANCommentedOn').
    EventFilterAttrs -> Maybe EventActionName
eventFilter_action :: Maybe EventActionName,
    -- | Filter by target type (e.g. 'ETTIssue', 'ETTMergeRequest').
    EventFilterAttrs -> Maybe EventTargetType
eventFilter_target_type :: Maybe EventTargetType,
    -- | Return events created before this date (ISO 8601).
    EventFilterAttrs -> Maybe UTCTime
eventFilter_before :: Maybe UTCTime,
    -- | Return events created after this date (ISO 8601).
    EventFilterAttrs -> Maybe UTCTime
eventFilter_after :: Maybe UTCTime,
    -- | Sort order: 'Asc' or 'Desc'.
    EventFilterAttrs -> Maybe SortBy
eventFilter_sort :: Maybe SortBy
  }

-- | Default event filters: no filtering applied.
defaultEventFilters :: EventFilterAttrs
defaultEventFilters :: EventFilterAttrs
defaultEventFilters =
  EventFilterAttrs
    { eventFilter_action :: Maybe EventActionName
eventFilter_action = Maybe EventActionName
forall a. Maybe a
Nothing,
      eventFilter_target_type :: Maybe EventTargetType
eventFilter_target_type = Maybe EventTargetType
forall a. Maybe a
Nothing,
      eventFilter_before :: Maybe UTCTime
eventFilter_before = Maybe UTCTime
forall a. Maybe a
Nothing,
      eventFilter_after :: Maybe UTCTime
eventFilter_after = Maybe UTCTime
forall a. Maybe a
Nothing,
      eventFilter_sort :: Maybe SortBy
eventFilter_sort = Maybe SortBy
forall a. Maybe a
Nothing
    }

-- | Get events for the currently authenticated user.
--
-- Calls @GET \/events@
currentUserEvents ::
  -- | filter attributes
  EventFilterAttrs ->
  GitLab [Event]
currentUserEvents :: EventFilterAttrs -> GitLab [Event]
currentUserEvents EventFilterAttrs
attrs = do
  Either (Response ByteString) [Event]
result <- Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Event])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
"/events" (EventFilterAttrs -> [GitLabParam]
eventFilters EventFilterAttrs
attrs)
  case Either (Response ByteString) [Event]
result of
    Left Response ByteString
er -> GitLabError -> GitLab [Event]
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError (Text
"currentUserEvents error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> Text
forall payload. Response payload -> Text
responseErrorText Response ByteString
er))
    Right [Event]
xs -> [Event] -> GitLab [Event]
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
xs

-- | Get events for a specific user.
--
-- Calls @GET \/users\/:id\/events@
userEvents ::
  -- | the user
  User ->
  -- | filter attributes
  EventFilterAttrs ->
  GitLab [Event]
userEvents :: User -> EventFilterAttrs -> GitLab [Event]
userEvents User
usr EventFilterAttrs
attrs = do
  Either (Response ByteString) [Event]
result <- Int
-> EventFilterAttrs
-> GitLab (Either (Response ByteString) [Event])
userEvents' (User -> Int
user_id User
usr) EventFilterAttrs
attrs
  case Either (Response ByteString) [Event]
result of
    Left Response ByteString
er -> GitLabError -> GitLab [Event]
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError (Text
"userEvents error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> Text
forall payload. Response payload -> Text
responseErrorText Response ByteString
er))
    Right [Event]
xs -> [Event] -> GitLab [Event]
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
xs

-- | Get events for a specific user by ID.
--
-- Calls @GET \/users\/:id\/events@
userEvents' ::
  -- | user ID
  Int ->
  -- | filter attributes
  EventFilterAttrs ->
  GitLab (Either (Response BSL.ByteString) [Event])
userEvents' :: Int
-> EventFilterAttrs
-> GitLab (Either (Response ByteString) [Event])
userEvents' Int
userId EventFilterAttrs
attrs =
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Event])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath (EventFilterAttrs -> [GitLabParam]
eventFilters EventFilterAttrs
attrs)
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/users/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
userId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/events"

-- | Get events for a project.
--
-- Calls @GET \/projects\/:id\/events@
projectEvents ::
  -- | the project
  Project ->
  -- | filter attributes
  EventFilterAttrs ->
  GitLab [Event]
projectEvents :: Project -> EventFilterAttrs -> GitLab [Event]
projectEvents Project
proj EventFilterAttrs
attrs = do
  Either (Response ByteString) [Event]
result <- Int
-> EventFilterAttrs
-> GitLab (Either (Response ByteString) [Event])
projectEvents' (Project -> Int
project_id Project
proj) EventFilterAttrs
attrs
  case Either (Response ByteString) [Event]
result of
    Left Response ByteString
er -> GitLabError -> GitLab [Event]
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError (Text
"projectEvents error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> Text
forall payload. Response payload -> Text
responseErrorText Response ByteString
er))
    Right [Event]
xs -> [Event] -> GitLab [Event]
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
xs

-- | Get events for a project by ID.
--
-- Calls @GET \/projects\/:id\/events@
projectEvents' ::
  -- | project ID
  Int ->
  -- | filter attributes
  EventFilterAttrs ->
  GitLab (Either (Response BSL.ByteString) [Event])
projectEvents' :: Int
-> EventFilterAttrs
-> GitLab (Either (Response ByteString) [Event])
projectEvents' Int
projectId EventFilterAttrs
attrs =
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Event])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath (EventFilterAttrs -> [GitLabParam]
eventFilters EventFilterAttrs
attrs)
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
projectId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/events"

-- | Get events for a group.
--
-- Calls @GET \/groups\/:id\/events@
groupEvents ::
  -- | the group
  Group ->
  -- | filter attributes
  EventFilterAttrs ->
  GitLab [Event]
groupEvents :: Group -> EventFilterAttrs -> GitLab [Event]
groupEvents Group
grp EventFilterAttrs
attrs = do
  Either (Response ByteString) [Event]
result <- Int
-> EventFilterAttrs
-> GitLab (Either (Response ByteString) [Event])
groupEvents' (Group -> Int
group_id Group
grp) EventFilterAttrs
attrs
  case Either (Response ByteString) [Event]
result of
    Left Response ByteString
er -> GitLabError -> GitLab [Event]
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError (Text
"groupEvents error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> Text
forall payload. Response payload -> Text
responseErrorText Response ByteString
er))
    Right [Event]
xs -> [Event] -> GitLab [Event]
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
xs

-- | Get events for a group by ID.
--
-- Calls @GET \/groups\/:id\/events@
groupEvents' ::
  -- | group ID
  Int ->
  -- | filter attributes
  EventFilterAttrs ->
  GitLab (Either (Response BSL.ByteString) [Event])
groupEvents' :: Int
-> EventFilterAttrs
-> GitLab (Either (Response ByteString) [Event])
groupEvents' Int
groupId EventFilterAttrs
attrs =
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Event])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath (EventFilterAttrs -> [GitLabParam]
eventFilters EventFilterAttrs
attrs)
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/groups/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
groupId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/events"

-- Internal helpers

eventFilters :: EventFilterAttrs -> [GitLabParam]
eventFilters :: EventFilterAttrs -> [GitLabParam]
eventFilters EventFilterAttrs
attrs =
  [Maybe GitLabParam] -> [GitLabParam]
forall a. [Maybe a] -> [a]
catMaybes
    [ (\EventActionName
a -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"action", Text -> Maybe ByteString
encodeText (EventActionName -> Text
actionParam EventActionName
a))) (EventActionName -> Maybe GitLabParam)
-> Maybe EventActionName -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventFilterAttrs -> Maybe EventActionName
eventFilter_action EventFilterAttrs
attrs,
      (\EventTargetType
t -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"target_type", Text -> Maybe ByteString
encodeText (EventTargetType -> Text
targetTypeParam EventTargetType
t))) (EventTargetType -> Maybe GitLabParam)
-> Maybe EventTargetType -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventFilterAttrs -> Maybe EventTargetType
eventFilter_target_type EventFilterAttrs
attrs,
      (\UTCTime
d -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"before", Text -> Maybe ByteString
encodeText (UTCTime -> Text
showTime UTCTime
d))) (UTCTime -> Maybe GitLabParam)
-> Maybe UTCTime -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventFilterAttrs -> Maybe UTCTime
eventFilter_before EventFilterAttrs
attrs,
      (\UTCTime
d -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"after", Text -> Maybe ByteString
encodeText (UTCTime -> Text
showTime UTCTime
d))) (UTCTime -> Maybe GitLabParam)
-> Maybe UTCTime -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventFilterAttrs -> Maybe UTCTime
eventFilter_after EventFilterAttrs
attrs,
      (\SortBy
s -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"sort", Text -> Maybe ByteString
encodeText (String -> Text
T.pack (SortBy -> String
forall a. Show a => a -> String
show SortBy
s)))) (SortBy -> Maybe GitLabParam) -> Maybe SortBy -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventFilterAttrs -> Maybe SortBy
eventFilter_sort EventFilterAttrs
attrs
    ]
  where
    encodeText :: Text -> Maybe BS.ByteString
    encodeText :: Text -> Maybe ByteString
encodeText = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Text -> ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
    showTime :: UTCTime -> Text
    showTime :: UTCTime -> Text
showTime = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show

-- | Convert 'EventActionName' to the string value expected by the
-- GitLab filter query parameter.
actionParam :: EventActionName -> Text
actionParam :: EventActionName -> Text
actionParam EventActionName
ANOpened = Text
"opened"
actionParam EventActionName
ANClosed = Text
"closed"
actionParam EventActionName
ANPushed = Text
"pushed"
actionParam EventActionName
ANCommentedOn = Text
"commented"
actionParam EventActionName
ANMerged = Text
"merged"
actionParam EventActionName
ANCreated = Text
"created"
actionParam EventActionName
ANUpdated = Text
"updated"
actionParam EventActionName
ANApproved = Text
"approved"
actionParam EventActionName
ANReopened = Text
"reopened"
actionParam EventActionName
ANLeft = Text
"left"
actionParam EventActionName
ANJoined = Text
"joined"
actionParam EventActionName
ANDestroyed = Text
"destroyed"
actionParam EventActionName
ANExpired = Text
"expired"
actionParam EventActionName
ANDeleted = Text
"deleted"
actionParam EventActionName
ANAccepted = Text
"accepted"
actionParam (ANOther Text
t) = Text
t

-- | Convert 'EventTargetType' to the lowercase string value expected
-- by the GitLab filter query parameter.
targetTypeParam :: EventTargetType -> Text
targetTypeParam :: EventTargetType -> Text
targetTypeParam EventTargetType
ETTIssue = Text
"issue"
targetTypeParam EventTargetType
ETTMilestone = Text
"milestone"
targetTypeParam EventTargetType
ETTMergeRequest = Text
"merge_request"
targetTypeParam EventTargetType
ETTNote = Text
"note"
targetTypeParam EventTargetType
ETTProject = Text
"project"
targetTypeParam EventTargetType
ETTSnippet = Text
"snippet"
targetTypeParam EventTargetType
ETTUser = Text
"user"
targetTypeParam EventTargetType
ETTWikiPage = Text
"wiki_page"
targetTypeParam EventTargetType
ETTDesign = Text
"design"
targetTypeParam (ETTOther Text
t) = Text
t