An IRC bot for learning, fun and collaboration in the Freepost community.

[[ 🗃 ^VvM9v funbot ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/VvM9v

SSH: git clone USERNAME@vervis.peers.community:VvM9v

Branches

Tags

master :: src / FunBot /

Types.hs

{- 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
[See repo JSON]