module Web.Hook.GitLab
( CommitID
, Url
, Author (..)
, User (..)
, Commit (..)
, MergeEndpoint (..)
, Repository (..)
, Issue (..)
, MergeRequest (..)
, Push (..)
, IssueEvent (..)
, MergeRequestEvent (..)
, Event (..)
, parse
)
where
import Control.Applicative
import Control.Monad (mzero)
import Data.Aeson
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
type CommitID = T.Text
type Url = T.Text
data Author = Author
{ authorName :: T.Text
, authorEmail :: T.Text
}
data User = User
{ userName :: T.Text
, userUsername :: T.Text
, userAvatar :: Url
}
data Commit = Commit
{ commitId :: CommitID
, commitMessage :: T.Text
, commitTimestamp :: T.Text
, commitUrl :: Url
, commitAuthor :: Author
}
data MergeEndpoint = MergeEndpoint
{ mepName :: T.Text
, mepSshUrl :: Url
, mepHttpurl :: Url
, mepVisibility :: Int
, mepNamespace :: T.Text
}
data Repository = Repository
{ repoName :: T.Text
, repoUrl :: Url
, repoDesc :: T.Text
, repoHomepage :: Url
, repoGitHttpUrl :: Url
, repoGitSshUrl :: Url
, repoVisibility :: Int
}
data Issue = Issue
{ issueInternalId :: Int
, issueTitle :: T.Text
, issueAssigneeId :: Int
, issueAuthorId :: Int
, issueProjectId :: Int
, issueCreatedAt :: T.Text
, issueUpdatedAt :: T.Text
, issuePosition :: Int
, issueBranch :: Maybe T.Text
, issueDescription :: T.Text
, issueMilestoneId :: Maybe Int
, issueState :: T.Text
, issueId :: Int
, issueUrl :: Url
}
data MergeRequest = MergeRequest
{ mrInternalId :: Int
, mrTargetBranch :: T.Text
, mrSourceBranch :: T.Text
, mrSourceProjectId :: Int
, mrAuthorId :: Int
, mrAssigneeId :: Maybe Int
, mrTitle :: T.Text
, mrCreatedAt :: T.Text
, mrUpdatedAt :: T.Text
, mrMilestoneId :: Maybe Int
, mrState :: T.Text
, mrMergeStatus :: T.Text
, mrTargetProjectId :: Int
, mrId :: Int
, mrDescription :: T.Text
, mrSource :: MergeEndpoint
, mrTarget :: MergeEndpoint
, mrLastCommit :: Commit
, mrUrl :: Url
}
data Push = Push
{ pushBefore :: CommitID
, pushAfter :: CommitID
, pushRef :: T.Text
, pushUserId :: Int
, pushUserName :: T.Text
, pushUserEmail :: T.Text
, pushProjectId :: Int
, pushRepository :: Repository
, pushCommits :: [Commit]
, pushCommitsTotal :: Int
}
data IssueEvent = IssueEvent
{ ieUser :: User
, ieIssue :: Issue
, ieAction :: T.Text
}
data MergeRequestEvent = MergeRequestEvent
{ mreUser :: User
, mreRequest :: MergeRequest
, mreAction :: T.Text
}
data Event
= EventPush Push
| EventPushTag Push
| EventIssue IssueEvent
| EventMergeRequest MergeRequestEvent
instance FromJSON Author where
parseJSON (Object v) =
Author <$>
v .: "name" <*>
v .: "email"
parseJSON _ = mzero
instance FromJSON User where
parseJSON (Object v) =
User <$>
v .: "name" <*>
v .: "username" <*>
v .: "avatar_url"
parseJSON _ = mzero
instance FromJSON Commit where
parseJSON (Object v) =
Commit <$>
v .: "id" <*>
v .: "message" <*>
v .: "timestamp" <*>
v .: "url" <*>
v .: "author"
parseJSON _ = mzero
instance FromJSON MergeEndpoint where
parseJSON (Object v) =
MergeEndpoint <$>
v .: "name" <*>
v .: "ssh_url" <*>
v .: "http_url" <*>
v .: "visibility_level" <*>
v .: "namespace"
parseJSON _ = mzero
instance FromJSON Repository where
parseJSON (Object v) =
Repository <$>
v .: "name" <*>
v .: "url" <*>
v .: "description" <*>
v .: "homepage" <*>
v .: "git_http_url" <*>
v .: "git_ssh_url" <*>
v .: "visibility_level"
parseJSON _ = mzero
instance FromJSON Issue where
parseJSON (Object v) =
Issue <$>
v .: "id" <*>
v .: "title" <*>
v .: "assignee_id" <*>
v .: "author_id" <*>
v .: "project_id" <*>
v .: "created_at" <*>
v .: "updated_at" <*>
v .: "position" <*>
v .: "branch_name" <*>
v .: "description" <*>
v .: "milestone_id" <*>
v .: "state" <*>
v .: "iid" <*>
v .: "url"
parseJSON _ = mzero
instance FromJSON MergeRequest where
parseJSON (Object v) =
MergeRequest <$>
v .: "id" <*>
v .: "target_branch" <*>
v .: "source_branch" <*>
v .: "source_project_id" <*>
v .: "author_id" <*>
v .: "assignee_id" <*>
v .: "title" <*>
v .: "created_at" <*>
v .: "updated_at" <*>
v .: "milestone_id" <*>
v .: "state" <*>
v .: "merge_status" <*>
v .: "target_project_id" <*>
v .: "iid" <*>
v .: "description" <*>
v .: "source" <*>
v .: "target" <*>
v .: "last_commit" <*>
v .: "url"
parseJSON _ = mzero
instance FromJSON Push where
parseJSON (Object v) =
Push <$>
v .: "before" <*>
v .: "after" <*>
v .: "ref" <*>
v .: "user_id" <*>
v .: "user_name" <*>
v .: "user_email" <*>
v .: "project_id" <*>
v .: "repository" <*>
v .: "commits" <*>
v .: "total_commits_count"
parseJSON _ = mzero
text :: Parser T.Text -> T.Text -> Parser T.Text
text parser expected = do
got <- parser
if got == expected
then return got
else mzero
instance FromJSON IssueEvent where
parseJSON (Object o) = do
user <- o .: "user"
attrs <- o .: "object_attributes"
mr <- o .: "object_attributes"
action <- attrs .: "action"
return $ IssueEvent user mr action
parseJSON _ = mzero
instance FromJSON MergeRequestEvent where
parseJSON (Object o) = do
user <- o .: "user"
attrs <- o .: "object_attributes"
issue <- o .: "object_attributes"
action <- attrs .: "action"
return $ MergeRequestEvent user issue action
parseJSON _ = mzero
instance FromJSON Event where
parseJSON v@(Object o) =
let kind = text $ o .: "object_kind"
in kind "push" *> (EventPush <$> parseJSON v) <|>
kind "tag_push" *> (EventPushTag <$> parseJSON v) <|>
kind "issue" *> (EventIssue <$> parseJSON v) <|>
kind "merge_request" *> (EventMergeRequest <$> parseJSON v)
parseJSON _ = mzero
parse :: B.ByteString -> Either String Event
parse = eitherDecode