{- This file is part of vcs-web-hook-parse. - - Written in 2015 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} {-# LANGUAGE OverloadedStrings #-} 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 --, mrStCommits :: [Int] -- dummy type; what is this? --, mrStDiffs :: [Int] -- dummy type; what is this? , 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 .: "st_commits" <*> --v .: "st_diffs" <*> 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 a JSON string (the body of the HTTP request) into event information. -- If parsing fails, return 'Left' an error message. parse :: B.ByteString -> Either String Event parse = eitherDecode