{- This file is part of funbot. - - Written in 2015, 2016 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 - . -} -- For deriving trivial no-op Hashable instances for newtypes {-# LANGUAGE GeneralizedNewtypeDeriving #-} module FunBot.Types ( RepoName (..) , RepoSpace (..) , BranchName (..) , DevHostLabel (..) , DevHost (..) , FeedLabel (..) , ShortcutLabel (..) , LocationLabel (..) , Location (..) , Filter (..) , BranchFilter , RepoAnnSpec (..) , NewsItemFields (..) , NewsAnnSpec (..) , NewsFeed (..) , BotEnv (..) , ChanSettings (..) , Settings (..) , Shortcut (..) , SettingsOption , SettingsTree , Memo (..) , HistoryDisplay (..) , UserOptions (..) , BotState (..) , BotSession , ExtEventSource , ExtEventHandler , Respond , BotCmd ) where import Control.Concurrent.Chan (Chan) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.CaseInsensitive (CI) import Data.Functor ((<$>)) import Data.Hashable (Hashable) import Data.HashMap.Lazy (HashMap) import Data.HashSet (HashSet) import Data.Sequence (Seq) import Data.Settings.Types (Section (..), Option (..)) import Data.Text (Text) import Data.Time.Clock (UTCTime) import FunBot.ExtEvents (ExtEvent) import Network.IRC.Fun.Bot.Types (Session, EventSource, EventHandler, Command) import Network.IRC.Fun.Types.Base (Nickname, Channel, MsgContent) import Web.Feed.Collect (CommandQueue) import qualified Data.CaseInsensitive as CI instance (FromJSON s, CI.FoldCase s) => FromJSON (CI s) where parseJSON v = CI.mk <$> parseJSON v instance ToJSON s => ToJSON (CI s) where toJSON = toJSON . CI.original -- | A version control repository name newtype RepoName = RepoName { unRepoName :: CI Text } deriving (Eq, Hashable) -- | A repo hosting service repo namespace, e.g. user or team name newtype RepoSpace = RepoSpace { unRepoSpace :: CI Text } deriving (Eq, Hashable) -- | A version control repository branch name newtype BranchName = BranchName { unBranchName :: Text } deriving (Eq, FromJSON, ToJSON) -- | A repo hosting service host label newtype DevHostLabel = DevHostLabel { unDevHostLabel :: Text } deriving (Eq, Hashable) -- | A repo hosting service DNS name newtype DevHost = DevHost { unDevHost :: CI Text } deriving (Eq, Hashable) -- | TODO newtype FeedLabel = FeedLabel { unFeedLabel :: CI Text } deriving (Eq, Hashable) -- | TODO newtype ShortcutLabel = ShortcutLabel { unShortcutLabel :: CI Text } deriving (Eq, Hashable) -- | TODO newtype LocationLabel = LocationLabel { unLocationLabel :: CI Text } deriving (Eq, Hashable) -- | TODO newtype Location = Location { unLocation :: Text } -- | Generic item filter data Filter a = Accept [a] | Reject [a] -- | Chooser for repo branches whose commits should be announced to IRC type BranchFilter = Filter BranchName -- | Configuration for announcing a git repo's events to a specific channel data RepoAnnSpec = RepoAnnSpec { -- | IRC channel into which to announce rasChannel :: Channel -- | Branch filter to choose which branches to announce , rasBranches :: BranchFilter -- | Whether to report all commits in a push ('True') or shorten long -- pushes to avoid channel spam ('False'). , rasAllCommits :: Bool -- | Whether to announce commits and tags. , rasCommits :: Bool -- | Whether to announce issues. , rasIssues :: Bool -- | Whether to announce merge requests. , rasMergeRequests :: Bool -- | Whether to announce snippets. , rasSnippets :: Bool -- | Whether to announce notes (comments). , rasNotes :: Bool -- | Whether to announce recent fresh events. , rasNew :: Bool -- | Whether to announce older events sent retroactively. , rasOld :: Bool -- | Wherher to announce events whose time isn't specified. , rasUntimed :: Bool } -- | Pick news item fields to display data NewsItemFields = NewsItemFields { dispFeedTitle :: Bool , dispAuthor :: Bool , dispUrl :: Bool } -- | Configuration for announcing news items data NewsAnnSpec = NewsAnnSpec { -- | IRC channels into which to announce nAnnChannels :: [Channel] -- | Filter for picking news item fields to display or hide , nAnnFields :: NewsItemFields } -- | A web news feed from which the bot can read and announce new items data NewsFeed = NewsFeed { -- | The feed URL nfUrl :: Text -- | Whether the feed watcher is watching this feed , nfActive :: Bool -- | Item announcement details , nfAnnSpec :: NewsAnnSpec } -- | Read-only custom bot environment data BotEnv = BotEnv { -- | Port on which the web hook event source will run webHookSourcePort :: Int -- | An 'IO' action which schedules saving settings to disk. There is a -- wrapper in the 'Session' monad which uses this with the settings -- stored in bot state, so you probably don't need this field directly. , saveSettings :: Settings -> IO () -- | Similarly for memos. , saveMemos :: HashMap Nickname [Memo] -> IO () -- | Similarly for user options. , saveUserOpts :: HashMap Nickname UserOptions -> IO () -- | Similarly for known nicks. , saveNicks :: HashMap Channel (HashSet Nickname) -> IO () -- | Filename for logging feed listener errors , feedErrorLogFile :: FilePath -- | Command queue for controlling the news feed watcher source , feedCmdQueue :: CommandQueue -- | Ext event loopback queue for inserting ext events , loopbackQueue :: Chan ExtEvent } -- | A special string which the bot can detect and translate into a longer -- form, e.g. a full URL. data Shortcut = Shortcut { -- | String by which the shortcut is detected. For example, if you'd like -- \"SD-258\" to refer to the URL of ticket #258, then you should set -- the prefix to \"SD-\". shPrefix :: Text -- | The generated longer form is a concatenation of this field, the -- shortcut string (without the prefix) and 'shAfter'. , shBefore :: Text -- | The generated longer form is a concatenation of 'shBefore', the -- shortcut string (without the prefix) and this field. , shAfter :: Text -- | The channels in which this shortcut should be applied. , shChannels :: [Channel] } -- | Per-channel settings data ChanSettings = ChanSettings { -- | Whether to display URL titles (the default is yes). csSayTitles :: Bool -- | Whether to welcome new users when the channel is quiet. , csWelcome :: Bool -- | Nicks to mention in the welcome message. , csFolks :: [Nickname] -- | Email address for async discussions. , csEmail :: Text -- | Generic key-value mapping intended to refer to URLs by short labels. , csLocations :: HashMap LocationLabel Location -- | Users who can ask the bot to send an arbitrary message in the -- channel. Can be useful but also dangerous, manage with care. , csPuppeteers :: HashSet Nickname -- | URL of an IRCBrowse instance for the specific channel. , csBrowse :: Maybe Text } -- | User-modifiable bot behavior settings data Settings = Settings { -- | Maps a host label to Git repo space+name to annoucement details stGitAnnChans :: HashMap DevHostLabel (HashMap (RepoSpace, RepoName) (Seq RepoAnnSpec)) -- | Maps a feed label to its URL and announcement details , stWatchedFeeds :: HashMap FeedLabel NewsFeed -- | Maps a shortcut label to its spec , stShortcuts :: HashMap ShortcutLabel Shortcut -- | Per-channel settings , stChannels :: HashMap Channel ChanSettings -- | Maps host names to host labels , stDevHosts :: HashMap DevHost DevHostLabel -- | A generic key-value mapping intended to refer to URLs by short -- labels. This is a global mapping, and there are also per-channel -- mappings in 'ChanSettings'. , stLocations :: HashMap LocationLabel Location -- | Users who can ask the bot to send an arbitrary message in an -- arbitrary channel. This gives a lot of power but is also dangerous, -- use with care. There are also per-channel puppeteers, see -- 'ChanSettings'. , stPuppeteers :: HashSet Nickname } -- | Alias for the settings option type type SettingsOption = Option BotSession -- | Alias for the settings section type type SettingsTree = Section BotSession -- | A message left to an offline user, for them to read later. data Memo = Memo { memoTime :: Text , memoSender :: Nickname , memoRecvIn :: Maybe Channel , memoSendIn :: Maybe Channel , memoContent :: MsgContent } -- | History display options per channel data HistoryDisplay = HistoryDisplay { -- | Whether channel history should be displayed hdEnabled :: Bool -- | Maximal number of messages to show , hdMaxLines :: Int } -- | Per-user options, consider private user info data UserOptions = UserOptions { -- | History display options per channel uoHistoryDisplay :: HashMap Channel HistoryDisplay } -- | Read-write custom bot state data BotState = BotState { -- | User-modifiable bot behavior settings bsSettings :: Settings -- | Settings tree and access definition for UI , bsSTree :: SettingsTree -- | Memos waiting for users to connect. , bsMemos :: HashMap Nickname [Memo] -- | Per-user options , bsUserOptions :: HashMap Nickname UserOptions -- | Known nicks in channels , bsKnownNicks :: HashMap Channel (HashSet Nickname) -- | Time of last message per channel. , bsLastMsgTime :: HashMap Channel UTCTime -- | Channels for which puppet mode is enabled, and by which user. , bsPuppet :: HashMap Channel Nickname -- | Whether private puppet mode is enabled, and by which user. It allows -- the user to ask the bot to send a private message to another user. , bsPrivPuppet :: Maybe Nickname } -- | Shortcut alias for bot session monad type BotSession = Session BotEnv BotState -- | Shortcut alias for event source function type type ExtEventSource = EventSource BotEnv BotState ExtEvent -- | Shortcut alias for event handler function type type ExtEventHandler = EventHandler BotEnv BotState ExtEvent -- | The type of command response functions type Respond = Maybe Channel -> Nickname -> [Text] -> (MsgContent -> BotSession ()) -> BotSession () -- | Bot command type type BotCmd = Command BotEnv BotState