{- This file is part of funbot-ext-events.
-
- Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
-
- ♡ 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
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
-- For json field names
{-# LANGUAGE OverloadedStrings #-}
module FunBot.ExtEvents
( Repository (..)
, ProjectObject (..)
, Commit (..)
, Push (..)
, Tag (..)
, Issue (..)
, Note (..)
, MergeRequest (..)
, NewsItem (..)
, Paste (..)
, ExtEvent (..)
)
where
import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch)
import Data.Text (Text)
-- | A version control repository.
data Repository = Repository
{ -- | The repository's name. For example, @funbot-ext-events@.
repoName :: Text
-- | The repository's namespace, i.e. username or team name under which
-- the repository is being managed. For example, @fr33domlover@.
, repoSpace :: Text
-- | Network location where the repository is hosted. For now this should
-- in most cases be the website URL's host part, but could be something
-- else if/when we have distributed repository sharing. For example,
-- @notabug.org@.
, repoHost :: Text
}
deriving Show
instance FromJSON Repository where
parseJSON (Object o) =
Repository <$>
o .: "name" <*>
o .: "space" <*>
o .: "host"
parseJSON v = typeMismatch "Repository" v
instance ToJSON Repository where
toJSON repo = object
[ "name" .= repoName repo
, "space" .= repoSpace repo
, "host" .= repoHost repo
]
-- | An object that is part of a project, such as a merge request or an issue
-- or a series of commits being pushed.
data ProjectObject a = ProjectObject
{ -- | The project repository.
poRepo :: Repository
-- | The object itself.
, poObj :: a
}
deriving Show
instance FromJSON a => FromJSON (ProjectObject a) where
parseJSON (Object o) =
ProjectObject <$>
o .: "repo" <*>
o .: "obj"
parseJSON v = typeMismatch "ProjectObject" v
instance ToJSON a => ToJSON (ProjectObject a) where
toJSON po = object
[ "repo" .= poRepo po
, "obj" .= poObj po
]
-- | A version control system commit, i.e. a set of changes with a description.
data Commit = Commit
{ -- | The author name. For example, @John Doe@.
commitAuthor :: Text
-- | The commit title. For example, @Support encrypted messages@.
, commitTitle :: Text
-- | A web view URL at which the commit details can be displayed.
, commitUrl :: Text
-- | A list of files (relative to the repository top level) added to the
-- repository in this commit. For example, @src\/FunBot\/ExtEvents.hs@.
, commitAdded :: [Text]
-- | A list of files modified in the repository in this commit.
, commitModified :: [Text]
-- | A list of files removed from the repository in this commit.
, commitRemoved :: [Text]
}
deriving Show
instance FromJSON Commit where
parseJSON (Object o) =
Commit <$>
o .: "author" <*>
o .: "title" <*>
o .: "url" <*>
o .: "added" <*>
o .: "modified" <*>
o .: "removed"
parseJSON v = typeMismatch "Commit" v
instance ToJSON Commit where
toJSON (Commit author title url added modified removed) = object
[ "author" .= author
, "title" .= title
, "url" .= url
, "added" .= added
, "modified" .= modified
, "removed" .= removed
]
-- | A version control push operation, i.e. one or more commits being added to
-- a specific branch or a repsitory. Note that tags can be pushed too, but for
-- that see the 'Tag' type.
data Push = Push
{ pushBranch :: Text
, pushCommits :: [Commit]
}
deriving Show
instance FromJSON Push where
parseJSON (Object o) =
Push <$>
o .: "branch" <*>
o .: "commits"
parseJSON v = typeMismatch "Push" v
instance ToJSON Push where
toJSON (Push branch commits) = object
[ "branch" .= branch
, "commits" .= commits
]
-- | A version control tag. Allows a specific state of the repository to be
-- referred by name.
data Tag = Tag
{ -- | Tag author name, for example @John Doe@.
tagAuthor :: Text
-- | Tag label, for example @0.3.4.1@ (referring to a release version).
, tagRef :: Text
}
deriving Show
instance FromJSON Tag where
parseJSON (Object o) =
Tag <$>
o .: "author" <*>
o .: "ref"
parseJSON v = typeMismatch "Tag" v
instance ToJSON Tag where
toJSON tag = object
[ "author" .= tagAuthor tag
, "ref" .= tagRef tag
]
-- | A bug, request or other work item attached to a project.
data Issue = Issue
{ -- | Issue author name. For example, @John Doe@.
issueAuthor :: Text
-- | The issue's unique identifier.
, issueId :: Int
-- | Issue title text.
, issueTitle :: Text
-- | A web view URL at which the issue's details can be viewed and
-- perhaps modified.
, issueUrl :: Text
-- | An action being applied to the issue, which is causing the event to
-- be sent to the FunBot instance.
, issueAction :: Text
}
deriving Show
instance FromJSON Issue where
parseJSON (Object o) =
Issue <$>
o .: "author" <*>
o .: "id" <*>
o .: "title" <*>
o .: "url" <*>
o .: "action"
parseJSON v = typeMismatch "Issue" v
instance ToJSON Issue where
toJSON issue = object
[ "author" .= issueAuthor issue
, "id" .= issueId issue
, "title" .= issueTitle issue
, "url" .= issueUrl issue
, "action" .= issueAction issue
]
-- | A comment made on some project object.
data Note = Note
{ -- | Note author name, e.g. @John Doe@.
noteAuthor :: Text
-- | Note content for the bot to display. Since notes can be long, this
-- should be only the portion for the bot to display. The bot should
-- examine this field and shorten long notes, but you shouldn't rely on
-- it and provide the right short part here.
, noteContent :: Text
-- | The project object being commented on, e.g. @issue #419@.
, noteTarget :: Text
-- | A web view URL at which the note can be viewed.
, noteUrl :: Text
}
deriving Show
instance FromJSON Note where
parseJSON (Object o) =
Note <$>
o .: "author" <*>
o .: "content" <*>
o .: "target" <*>
o .: "url"
parseJSON v = typeMismatch "Note" v
instance ToJSON Note where
toJSON (Note author content target url) = object
[ "author" .= author
, "content" .= content
, "target" .= target
, "url" .= url
]
-- | A request from a user to merge their code changes into the project.
data MergeRequest = MergeRequest
{ -- | Merge request author name, e.g. @John Doe@.
mrAuthor :: Text
-- | Merge request unique identifier.
, mrId :: Int
-- | Merge request title.
, mrTitle :: Text
-- | A web view URL at which the merge request can be viewed and perhaps
-- edited.
, mrUrl :: Text
-- | An action being applied to the merge request, which is causing the
-- event to be sent to the FunBot instance.
, mrAction :: Text
}
deriving Show
instance FromJSON MergeRequest where
parseJSON (Object o) =
MergeRequest <$>
o .: "author" <*>
o .: "id" <*>
o .: "title" <*>
o .: "url" <*>
o .: "action"
parseJSON v = typeMismatch "MergeRequest" v
instance ToJSON MergeRequest where
toJSON mr = object
[ "author" .= mrAuthor mr
, "id" .= mrId mr
, "title" .= mrTitle mr
, "url" .= mrUrl mr
, "action" .= mrAction mr
]
-- | A news feed item.
data NewsItem = NewsItem
{ -- | Short label identifying the new feed to which the item belongs.
itemFeedLabel :: Text
-- | The name of the feed to which the item belongs.
, itemFeedTitle :: Maybe Text
-- | Item title.
, itemTitle :: Text
-- | Item author name.
, itemAuthor :: Maybe Text
-- | URL at which the item's content can be viewed.
, itemUrl :: Maybe Text
}
deriving Show
instance FromJSON NewsItem where
parseJSON (Object o) =
NewsItem <$>
o .: "feed-label" <*>
o .: "feed-title" <*>
o .: "title" <*>
o .: "author" <*>
o .: "url"
parseJSON v = typeMismatch "NewsItem" v
instance ToJSON NewsItem where
toJSON (NewsItem fLabel fTitle title author url) = object
[ "feed-label" .= fLabel
, "feed-title" .= fTitle
, "title" .= title
, "author" .= author
, "url" .= url
]
-- | A piece of text uploaded to a website for quick sharing.
data Paste = Paste
{ -- | Paste author name or IRC nickname.
pasteAuthor :: Text
-- | Verb indicating the action done with the paste.
, pasteVerb :: Text
-- | Paste title.
, pasteTitle :: Text
-- | URL at which the paste content can be viewed.
, pasteUrl :: Text
-- | An IRC channel into which to announce the paste.
, pasteChannel :: Text
}
deriving Show
instance FromJSON Paste where
parseJSON (Object o) =
Paste <$>
o .: "author" <*>
o .: "verb" <*>
o .: "title" <*>
o .: "url" <*>
o .: "channel"
parseJSON v = typeMismatch "Paste" v
instance ToJSON Paste where
toJSON (Paste author verb title url chan) = object
[ "author" .= author
, "verb" .= verb
, "title" .= title
, "url" .= url
, "channel" .= chan
]
-- | An event coming from one of the external event sources.
data ExtEvent
-- | Git commits pushed into a repo.
= GitPushEvent (ProjectObject Push)
-- | A git tag pushed into a repo.
| GitTagEvent (ProjectObject Tag)
-- | An issue related event.
| IssueEvent (ProjectObject Issue)
-- | A merge request related event.
| MergeRequestEvent (ProjectObject MergeRequest)
-- | A comment made on an issue or MR or some other object.
| NoteEvent (ProjectObject Note)
-- | New news item published.
| NewsEvent NewsItem
-- | Paste related event in a paste server.
| PasteEvent Paste
-- | A new IRC user needs to be welcomed to a channel.
| WelcomeEvent Text Text
deriving Show
text :: Parser Text -> Text -> Parser Text
text parser expected = do
got <- parser
if got == expected
then return got
else empty
instance FromJSON ExtEvent where
parseJSON (Object o) =
let kind = text $ o .: "type"
event label ctor = kind label *> (ctor <$> o .: "data")
in event "push" GitPushEvent <|>
event "tag" GitTagEvent <|>
event "mr" MergeRequestEvent <|>
event "note" NoteEvent <|>
event "issue" IssueEvent <|>
event "news" NewsEvent <|>
event "paste" PasteEvent
parseJSON v = typeMismatch "ExtEvent" v
instance ToJSON ExtEvent where
toJSON (GitPushEvent commits) = object [ "type" .= ("push" :: Text)
, "data" .= commits
]
toJSON (GitTagEvent tag) = object [ "type" .= ("tag" :: Text)
, "data" .= tag
]
toJSON (IssueEvent issue) = object [ "type" .= ("issue" :: Text)
, "data" .= issue
]
toJSON (MergeRequestEvent mr) = object [ "type" .= ("mr" :: Text)
, "data" .= mr
]
toJSON (NoteEvent note) = object [ "type" .= ("note" :: Text)
, "data" .= note
]
toJSON (NewsEvent item) = object [ "type" .= ("news" :: Text)
, "data" .= item
]
toJSON (PasteEvent paste) = object [ "type" .= ("paste" :: Text)
, "data" .= paste
]
toJSON (WelcomeEvent _ _) = object []