Paste server written in Haskell. Fork of Hpaste, fully freedom and privacy respecting and generally improved. At the time of writing there's an instance at <http://paste.rel4tion.org>.
Clone
HTTPS:
git clone https://vervis.peers.community/repos/aoqmo
SSH:
git clone USERNAME@vervis.peers.community:aoqmo
Branches
Tags
Announcer.hs
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-- | IRC announcer.
module Hpaste.Model.Announcer
(newAnnouncer
,announce
)
where
import Hpaste.Types.Announcer
import Control.Monad.Fix
import Control.Concurrent
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Env (env)
import Control.Monad.IO (io)
import qualified Data.ByteString as B
import Data.Monoid.Operator ((++))
import Data.Char
import Data.Text (Text,pack,unpack)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Time
import qualified Data.Text.IO as T
import FunBot.Client
import FunBot.ExtEvents (Paste)
import Network
import Network.URI
import Prelude hiding ((++))
import Snap.App.Types
import System.IO
-- | Start a thread and return a channel to it.
newAnnouncer :: AnnounceConfig -> IO Announcer
newAnnouncer config = do
ans <- newChan
case parseURI $ announceUrl config of
Just url -> do
let self = Announcer { annChan = ans, annBot = mkBot url False }
_ <- forkIO $ announcer self (const (return ()))
return self
Nothing -> error "invalid funbot URL"
-- | Run the announcer bot.
announcer :: Announcer -> (Handle -> IO ()) -> IO ()
announcer self@Announcer{annBot=bot,annChan=ans} cont = do
announcements <- getChanContents ans
forM_ announcements $ \ (Announcement paste) ->
E.catch (void $ sendExtEvent bot $ mkPasteEvent paste)
(\(e::IOError) -> return ())
-- | Announce something to the IRC.
announce :: Announcer -> Paste -> IO ()
announce Announcer{annChan=chan} paste = do
io $ writeChan chan $ Announcement paste
|