diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -3,6 +3,30 @@ +vcs-web-hook-parse 0.2.0.0 -- 2016-01-27 +======================================== + +General, build and documentation changes: + +* (None) + +New APIs, features and enhancements: + +* Add added/modified/removed file list fields to Commit for Gitlab +* Support for Gitlab note events + +Bug fixes: + +* (None) + +Dependency changes: + +* (None) + + + + + vcs-web-hook-parse 0.1.0.0 -- 2015-08-10 ======================================== diff --git a/src/Web/Hook/GitLab.hs b/src/Web/Hook/GitLab.hs --- a/src/Web/Hook/GitLab.hs +++ b/src/Web/Hook/GitLab.hs @@ -18,16 +18,22 @@ module Web.Hook.GitLab ( CommitID , Url + , File , Author (..) , User (..) , Commit (..) , MergeEndpoint (..) , Repository (..) + , Diff (..) + , Snippet (..) + , NoteTarget (..) , Issue (..) , MergeRequest (..) + , Note (..) , Push (..) , IssueEvent (..) , MergeRequestEvent (..) + , NoteEvent (..) , Event (..) , parse ) @@ -36,7 +42,8 @@ import Control.Applicative import Control.Monad (mzero) import Data.Aeson -import Data.Aeson.Types (Parser) +import Data.Aeson.Types (Parser, typeMismatch) + import qualified Data.ByteString.Lazy as B import qualified Data.Text as T @@ -44,43 +51,107 @@ 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 + , 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 :: Url - , repoGitSshUrl :: Url - , repoVisibility :: Int + , 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 @@ -98,6 +169,25 @@ , 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 @@ -119,9 +209,97 @@ , 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" <*> + --v .: "st_commits" <*> + --v .: "st_diffs" <*> + 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 + --, noteType :: NoteableType + , noteAuthorId :: Int + , noteCreatedAt :: T.Text + , noteUpdatedAt :: T.Text + , noteProjectId :: Int + --, noteAttachment :: Maybe () + , 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 .: "noteable_type" <*> + o .: "author_id" <*> + o .: "created_at" <*> + o .: "updated_at" <*> + o .: "project_id" <*> + --o .: "attachment" <*> + 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 @@ -135,116 +313,6 @@ , 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 <$> @@ -260,39 +328,112 @@ 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 +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" - mr <- o .: "object_attributes" + issue <- o .: "object_attributes" action <- attrs .: "action" - return $ IssueEvent user mr action - parseJSON _ = mzero + 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" - issue <- o .: "object_attributes" + mr <- o .: "object_attributes" action <- attrs .: "action" - return $ MergeRequestEvent user issue action - parseJSON _ = mzero + 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) - parseJSON _ = mzero + kind "merge_request" *> (EventMergeRequest <$> parseJSON v) <|> + kind "note" *> (EventNote <$> parseJSON v) + parseJSON v = typeMismatch "Event" v -- | Parse a JSON string (the body of the HTTP request) into event information. -- If parsing fails, return 'Left' an error message. diff --git a/vcs-web-hook-parse.cabal b/vcs-web-hook-parse.cabal --- a/vcs-web-hook-parse.cabal +++ b/vcs-web-hook-parse.cabal @@ -1,5 +1,5 @@ name: vcs-web-hook-parse -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Parse development platform web hook messages. description: A development platform is a server system which hosts (mostly software) @@ -39,7 +39,7 @@ source-repository head type: darcs - location: http://dev.rel4tion.org/fr33domlover/vcs-web-hook-parse + location: http://hub.darcs.net/fr33domlover/vcs-web-hook-parse library exposed-modules: Web.Hook.GitLab