By | fr33domlover |
At | 2015-09-19 |
Title | use funbot instead of the simple pseudo irc bot |
Description |
Edit file hpaste.conf.sample 33188 → 33188
4 4 user = hpaste
5 5 pass = hpaste
6 6 db = hpaste
7 7 8 8 [ANNOUNCE]
- 9 user = yourdomain
- 10 pass = yourpass
- 11 host = 127.0.0.1
- 12 port = 6667
+ 9 url = http://bot.mypaste.org/client
13 10 14 11 [WEB]
15 12 domain = yourdomain.org
16 13 cache = /tmp/hpaste-cache
17 14 … … … … Edit file src/Hpaste/Config.hs 33188 → 33188
17 17 getConfig :: FilePath -> IO Config
18 18 getConfig conf = do
19 19 contents <- readFile conf
20 20 let config = do
21 21 c <- readstring emptyCP contents
- 22 [user,pass,host,port]
- 23 <- mapM (get c "ANNOUNCE")
- 24 ["user","pass","host","port"]
+ 22 [bot] <- mapM (get c "ANNOUNCE") ["url"]
25 23 [pghost,pgport,pguser,pgpass,pgdb]
26 24 <- mapM (get c "POSTGRESQL")
27 25 ["host","port","user","pass","db"]
28 26 [domain,cache]
29 27 <- mapM (get c "WEB")
… … … … 38 36 <- mapM (get c "ADDRESSES")
39 37 ["admin","site_addy"]
40 38 [key] <- mapM (get c "ADMIN") ["key"]
41 39 42 40 return Config {
- 43 configAnnounce = AnnounceConfig user pass host (read port)
+ 41 configAnnounce = AnnounceConfig bot
44 42 , configPostgres = ConnectInfo pghost (read pgport) pguser pgpass pgdb
45 43 , configDomain = domain
46 44 , configCommits = commits
47 45 , configRepoURL = url
48 46 , configIrcDir = ircDir
… … … … Edit file src/Hpaste/Types/Announcer.hs 33188 → 33188
1 1 module Hpaste.Types.Announcer where
2 2 3 3 import Control.Concurrent
4 4 import Data.Text
+ 5 import FunBot.Client (Bot)
+ 6 import FunBot.ExtEvents (Paste)
5 7 6 8 -- | Announcer configuration.
- 7 data AnnounceConfig = AnnounceConfig {
- 8 announceUser :: String
- 9 , announcePass :: String
- 10 , announceHost :: String
- 11 , announcePort :: Int
- 12 } deriving (Show)
+ 9 newtype AnnounceConfig = AnnounceConfig { announceUrl:: String }
+ 10 deriving (Show)
13 11 14 12 -- | An announcer.
15 13 data Announcer = Announcer
- 16 { annChan :: Chan Announcement
- 17 , annConfig :: AnnounceConfig
+ 14 { annChan :: Chan Announcement
+ 15 , annBot :: Bot
18 16 }
19 17 20 18 -- | An annoucement.
- 21 data Announcement = Announcement
- 22 { annFrom :: Text
- 23 , annContent :: Text
- 24 , annChannel :: Text
- 25 }
+ 19 newtype Announcement = Announcement { annPaste :: Paste }
… … … … Edit file src/Hpaste/Model/Announcer.hs 33188 → 33188
25 25 import qualified Data.Text as T
26 26 import Data.Text.Encoding
27 27 import Data.Time
28 28 import qualified Data.Text.IO as T
29 29 import Network
+ 30 import Network.URI
30 31 import Prelude hiding ((++))
31 32 import Snap.App.Types
32 33 import System.IO
33 34 34 35 -- | Start a thread and return a channel to it.
35 36 newAnnouncer :: AnnounceConfig -> IO Announcer
36 37 newAnnouncer config = do
- 37 putStrLn "Connecting..."
38 38 ans <- newChan
- 39 let self = Announcer { annChan = ans, annConfig = config }
- 40 _ <- forkIO $ announcer self (const (return ()))
- 41 return self
+ 39 case parseURI $ announceUrl config of
+ 40 Just url -> do
+ 41 let self = Announcer { annChan = ans, annBot = mkBot url False }
+ 42 _ <- forkIO $ announcer self (const (return ()))
+ 43 return self
+ 44 Nothing -> error "invalid funbot URL"
42 45 43 46 -- | Run the announcer bot.
44 47 announcer :: Announcer -> (Handle -> IO ()) -> IO ()
- 45 announcer self@Announcer{annConfig=config,annChan=ans} cont = do
+ 48 announcer self@Announcer{annBot=bot,annChan=ans} cont = do
46 49 announcements <- getChanContents ans
- 47 forM_ announcements $ \ann ->
- 48 E.catch (sendIfNickExists config ann)
+ 50 forM_ announcements $ \ (Announcement paste) ->
+ 51 E.catch (void $ sendExtEvent bot $ mkPasteEvent paste)
49 52 (\(e::IOError) -> return ())
50 53 - 51 sendIfNickExists AnnounceConfig{..} (Announcement origin msg channel) = do
- 52 handle <- connectTo announceHost (PortNumber $ fromIntegral announcePort)
- 53 hSetBuffering handle LineBuffering
- 54 let send = B.hPutStrLn handle . encodeUtf8
- 55 line = "PRIVMSG " ++ channel ++ " :" ++ msg
- 56 send $ "PASS " ++ pack announcePass
- 57 send $ "USER " ++ pack announceUser ++ " * * *"
- 58 send $ "NICK " ++ pack announceUser
- 59 send $ "JOIN " ++ channel
- 60 send $ "WHOIS :" ++ origin
- 61 fix $ \loop -> do
- 62 incoming <- T.hGetLine handle
- 63 T.putStrLn incoming
- 64 case T.takeWhile isDigit (T.drop 1 (T.dropWhile (/=' ') incoming)) of
- 65 "311" -> send line
- 66 "401" -> return ()
- 67 _ -> loop
- 68 69 54 -- | Announce something to the IRC.
- 70 announce :: Announcer -> Text -> Text -> Text -> IO ()
- 71 announce Announcer{annChan=chan} nick channel line = do
- 72 io $ writeChan chan $ Announcement nick line channel
+ 55 announce :: Announcer -> Paste -> IO ()
+ 56 announce Announcer{annChan=chan} paste = do
+ 57 io $ writeChan chan $ Announcement paste
… … … … Edit file src/Hpaste/Model/Paste.hs 33188 → 33188
39 39 import Data.Monoid.Operator ((++))
40 40 import Data.Text (Text,unpack,pack)
41 41 import qualified Data.Text as T
42 42 import Data.Text.IO as T (writeFile)
43 43 import Data.Text.Lazy (fromStrict)
+ 44 import FunBot.ExtEvents (Paste (..))
44 45 import Language.Haskell.HLint
45 46 import Prelude hiding ((++))
46 47 import Snap.App
47 48 import System.Directory
48 49 import System.FilePath
… … … … 181 182 announcePaste ptype channel PasteSubmit{..} pid = do
182 183 conf <- env modelStateConfig
183 184 verb <- getVerb
184 185 unless (seemsLikeSpam pasteSubmitTitle || seemsLikeSpam pasteSubmitAuthor) $ do
185 186 announcer <- env modelStateAnns
- 186 io $ announce announcer pasteSubmitAuthor channel $ do
- 187 nick ++ " " ++ verb ++ " “" ++ pasteSubmitTitle ++ "” at " ++ link conf
+ 187 io $ announce announcer pasteSubmitAuthor channel $ Paste
+ 188 { pasteAuthor = nick
+ 189 , pasteVerb = verb
+ 190 , pasteTitle = pasteSubmitTitle
+ 191 , pasteUrl = link conf
+ 192 , pasteChannel = channel
+ 193 }
188 194 where nick | validNick (unpack pasteSubmitAuthor) = pasteSubmitAuthor
189 195 | otherwise = "“" ++ pasteSubmitAuthor ++ "”"
190 196 link Config{..} = "http://" ++ pack configDomain ++ "/" ++ pid'
191 197 pid' = case ptype of
192 198 NormalPaste -> showPid pid
… … … …