module Web.Hook.GitLab
( CommitID
, Url
, File
, Author (..)
, User (..)
, Commit (..)
, MergeEndpoint (..)
, Repository (..)
, Diff (..)
, Snippet (..)
, NoteTarget (..)
, Issue (..)
, MergeRequest (..)
, Note (..)
, Push (..)
, IssueEvent (..)
, MergeRequestEvent (..)
, NoteEvent (..)
, Event (..)
, parse
)
where
import Control.Applicative
import Control.Monad (mzero)
import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch)
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
type CommitID = T.Text
type Url = T.Text
type File = T.Text
text :: Parser T.Text -> T.Text -> Parser T.Text
text parser expected = do
got <- parser
if got == expected
then return got
else mzero
data Author = Author
{ authorName :: T.Text
, authorEmail :: T.Text
}
instance FromJSON Author where
parseJSON (Object o) =
Author <$>
o .: "name" <*>
o .: "email"
parseJSON v = typeMismatch "Author" v
data User = User
{ userName :: T.Text
, userUsername :: T.Text
, userAvatar :: Url
}
instance FromJSON User where
parseJSON (Object o) =
User <$>
o .: "name" <*>
o .: "username" <*>
o .: "avatar_url"
parseJSON v = typeMismatch "User" v
data Commit = Commit
{ commitId :: CommitID
, commitMessage :: T.Text
, commitTimestamp :: T.Text
, commitUrl :: Url
, commitAuthor :: Author
, commitAdded :: [File]
, commitModified :: [File]
, commitRemoved :: [File]
}
instance FromJSON Commit where
parseJSON (Object o) =
Commit <$>
o .: "id" <*>
o .: "message" <*>
o .: "timestamp" <*>
o .: "url" <*>
o .: "author" <*>
o .:? "added" .!= [] <*>
o .:? "modified" .!= [] <*>
o .:? "removed" .!= []
parseJSON v = typeMismatch "Commit" v
data MergeEndpoint = MergeEndpoint
{ mepName :: T.Text
, mepSshUrl :: Url
, mepHttpUrl :: Url
, mepWebUrl :: Url
, mepVisibility :: Int
, mepNamespace :: T.Text
}
instance FromJSON MergeEndpoint where
parseJSON (Object o) =
MergeEndpoint <$>
o .: "name" <*>
o .: "ssh_url" <*>
o .: "http_url" <*>
o .: "web_url" <*>
o .: "visibility_level" <*>
o .: "namespace"
parseJSON v = typeMismatch "MergeEndpoint" v
data Repository = Repository
{ repoName :: T.Text
, repoUrl :: Url
, repoDesc :: T.Text
, repoHomepage :: Url
, repoGitHttpUrl :: Maybe Url
, repoGitSshUrl :: Maybe Url
, repoVisibility :: Maybe Int
}
instance FromJSON Repository where
parseJSON (Object o) =
Repository <$>
o .: "name" <*>
o .: "url" <*>
o .: "description" <*>
o .: "homepage" <*>
o .:? "git_http_url" <*>
o .:? "git_ssh_url" <*>
o .:? "visibility_level"
parseJSON v = typeMismatch "Repository" v
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
}
instance FromJSON Issue where
parseJSON (Object o) =
Issue <$>
o .: "id" <*>
o .: "title" <*>
o .: "assignee_id" <*>
o .: "author_id" <*>
o .: "project_id" <*>
o .: "created_at" <*>
o .: "updated_at" <*>
o .: "position" <*>
o .: "branch_name" <*>
o .: "description" <*>
o .: "milestone_id" <*>
o .: "state" <*>
o .: "iid" <*>
o .:? "url" .!= T.empty
parseJSON v = typeMismatch "Issue" v
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
, mrWorkInProgress :: Bool
, mrUrl :: Url
}
instance FromJSON MergeRequest where
parseJSON (Object o) =
MergeRequest <$>
o .: "id" <*>
o .: "target_branch" <*>
o .: "source_branch" <*>
o .: "source_project_id" <*>
o .: "author_id" <*>
o .: "assignee_id" <*>
o .: "title" <*>
o .: "created_at" <*>
o .: "updated_at" <*>
o .: "milestone_id" <*>
o .: "state" <*>
o .: "merge_status" <*>
o .: "target_project_id" <*>
o .: "iid" <*>
o .: "description" <*>
o .: "source" <*>
o .: "target" <*>
o .: "last_commit" <*>
o .: "work_in_progress" <*>
o .:? "url" .!= T.empty
parseJSON v = typeMismatch "MergeRequest" v
data Diff = Diff
{ diffDiff :: T.Text
, diffNewPath :: T.Text
, diffOldPath :: T.Text
, diffAMode :: T.Text
, diffBMode :: T.Text
, diffNewFile :: Bool
, diffRenamedFile :: Bool
, diffDeletedFile :: Bool
}
instance FromJSON Diff where
parseJSON (Object o) =
Diff <$>
o .: "diff" <*>
o .: "new_path" <*>
o .: "old_path" <*>
o .: "a_mode" <*>
o .: "b_mode" <*>
o .: "new_file" <*>
o .: "renamed_file" <*>
o .: "deleted_file"
parseJSON v = typeMismatch "Diff" v
data Note = Note
{ noteId :: Int
, noteNote :: T.Text
, noteAuthorId :: Int
, noteCreatedAt :: T.Text
, noteUpdatedAt :: T.Text
, noteProjectId :: Int
, noteLineCode :: Maybe T.Text
, noteCommitId :: CommitID
, noteNoteableId :: Maybe Int
, noteSystem :: Bool
, noteStDiff :: Maybe Diff
, noteUrl :: Url
}
instance FromJSON Note where
parseJSON (Object o) =
Note <$>
o .: "id" <*>
o .: "note" <*>
o .: "author_id" <*>
o .: "created_at" <*>
o .: "updated_at" <*>
o .: "project_id" <*>
o .: "line_code" <*>
o .: "commit_id" <*>
o .: "noteable_id" <*>
o .: "system" <*>
o .: "st_diff" <*>
o .: "url"
parseJSON v = typeMismatch "Note" v
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
}
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
data IssueEvent = IssueEvent
{ ieUser :: User
, ieRepo :: Repository
, ieIssue :: Issue
, ieAction :: T.Text
}
instance FromJSON IssueEvent where
parseJSON (Object o) = do
user <- o .: "user"
repo <- o .: "repository"
attrs <- o .: "object_attributes"
issue <- o .: "object_attributes"
action <- attrs .: "action"
return $ IssueEvent user repo issue action
parseJSON v = typeMismatch "IssueEvent" v
data MergeRequestEvent = MergeRequestEvent
{ mreUser :: User
, mreRequest :: MergeRequest
, mreAction :: T.Text
}
instance FromJSON MergeRequestEvent where
parseJSON (Object o) = do
user <- o .: "user"
attrs <- o .: "object_attributes"
mr <- o .: "object_attributes"
action <- attrs .: "action"
return $ MergeRequestEvent user mr action
parseJSON v = typeMismatch "MergeRequestEvent" v
data Snippet = Snippet
{ snippetId :: Int
, snippetTitle :: T.Text
, snippetContent :: T.Text
, snippetAuthorId :: Int
, snippetProjectId :: Int
, snippetCreatedAt :: T.Text
, snippetUpdatedAt :: T.Text
, snippetFileName :: T.Text
, snippetExpiresAt :: Maybe T.Text
, snippetType :: T.Text
, snippetVisibility :: Int
}
instance FromJSON Snippet where
parseJSON (Object o) =
Snippet <$>
o .: "id" <*>
o .: "title" <*>
o .: "content" <*>
o .: "author_id" <*>
o .: "project_id" <*>
o .: "created_at" <*>
o .: "updated_at" <*>
o .: "file_name" <*>
o .: "expires_at" <*>
o .: "type" <*>
o .: "visibility_level"
parseJSON v = typeMismatch "Snippet" v
data NoteTarget
= NTCommit Commit
| NTIssue Issue
| NTMergeRequest MergeRequest
| NTSnippet Snippet
data NoteEvent = NoteEvent
{ neUser :: User
, neProjectId :: Int
, neRepo :: Repository
, neNote :: Note
, neTarget :: NoteTarget
}
instance FromJSON NoteEvent where
parseJSON (Object o) =
NoteEvent <$>
o .: "user" <*>
o .: "project_id" <*>
o .: "repository" <*>
o .: "object_attributes" <*>
( NTCommit <$> o .: "commit" <|>
NTMergeRequest <$> o .: "merge_request" <|>
NTIssue <$> o .: "issue" <|>
NTSnippet <$> o .: "snippet"
)
parseJSON v = typeMismatch "NoteEvent" v
data Event
= EventPush Push
| EventPushTag Push
| EventIssue IssueEvent
| EventMergeRequest MergeRequestEvent
| EventNote NoteEvent
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) <|>
kind "note" *> (EventNote <$> parseJSON v)
parseJSON v = typeMismatch "Event" v
parse :: B.ByteString -> Either String Event
parse = eitherDecode