An IRC bot for learning, fun and collaboration in the Freepost community.
Clone
HTTPS:
git clone https://vervis.peers.community/repos/VvM9v
SSH:
git clone USERNAME@vervis.peers.community:VvM9v
Branches
Tags
Types.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | {- This file is part of funbot.
-
- Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ 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 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
|