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
{-# LANGUAGE OverloadedStrings #-}

-- how to compile this
-- (may not be best practices since stack is all the rage these days)
-- (first, pick a folder, put this file there and cd into it)
-- $ add -f ghc
-- $ cabal sandbox init
-- $ git clone https://github.com/nelhage/hszephyr.git
-- $ cabal install ./hszephyr
-- $ cabal exec ghc -- numbers-bot.hs -rtsopts -Wall && ./numbers-bot +RTS -V0
--
-- hszephyr 0.2 is on hackage, but cabal hasn't been updated yet as of time of
-- writing, otherwise `cabal install hszephyr` would just work instead of the
-- git clone and cabal install from local folder.

import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar)
import Control.Concurrent (threadDelay, forkIO, ThreadId)
import Control.Monad (forever, forM_)
import Data.ByteString (ByteString)
import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Network.Zephyr
import Text.Read (readMaybe)
import System.Random (randomRIO)
import qualified Data.ByteString.Char8 as B

data BotState = BotState
    { currentClass :: ByteString
    , currentInstance :: ByteString
    , currentHolder :: Maybe ByteString
    , currentNumber :: Integer
    }

sendZephyr :: BotState -> ByteString -> IO ()
sendZephyr botState msg = sendNotice $ emptyNotice
    { z_class = currentClass botState
    , z_instance = currentInstance botState
    , z_recipient = ""
    , z_sender = Just "numbers-bot"
    , z_opcode = "auto"
    , z_kind = kind_acked
    , z_fields = ["[insert zsig here]", msg]
    }

zephyrState :: BotState -> IO ()
zephyrState botState = sendZephyr botState . B.pack . show $ currentNumber botState

hour :: Int -- in microseconds, for threadDelay
hour = 60 * 60 * 10^(6::Int)

forkSpontaneityThread :: MVar BotState -> IO ThreadId
forkSpontaneityThread botStateMVar = forkIO . forever $ do
    n <- randomRIO (3*hour, 6*hour)
    threadDelay n
    botState <- takeMVar botStateMVar
    delta <- randomRIO (-1, 1)
    let botState' = botState { currentNumber = currentNumber botState + delta }
    zephyrState botState'
    putMVar botStateMVar botState'

forkStdinAdminThread :: MVar BotState -> IO ThreadId
forkStdinAdminThread botStateMVar = forkIO . forever $ do
    s <- getLine
    forM_ (readMaybe s) $ \n -> do
        botState <- takeMVar botStateMVar
        let botState' = botState { currentNumber = n }
        zephyrState botState'
        putMVar botStateMVar botState'

-- first field is zsig, second field is body; not sure when there are three or
-- more fields
getBody :: ZNotice -> Maybe ByteString
getBody notice = case z_fields notice of
    (_:b:_) -> Just b
    _ -> Nothing

foreverListen :: MVar BotState -> IO ()
foreverListen botStateMVar = forever $ do
    notice <- receiveNotice
    botState <- takeMVar botStateMVar
    let sender = fromMaybe "" $ z_sender notice -- !?
    let recipient = z_recipient notice
    let maybeBody = getBody notice
    let opcode = z_opcode notice
    let audible =
            case currentHolder botState of
                Just kerb -> kerb == sender
                Nothing -> currentClass    botState == z_class    notice &&
                           currentInstance botState == z_instance notice

    nextBotState <- case (audible, recipient, B.map toLower opcode, maybeBody) of
        (False, _, _, _ )     -> putStrLn "Not audible"   >> return botState
        (True, _, _, Nothing) -> putStrLn "No body"       >> return botState
        (True, _, "auto", _)  -> putStrLn "Ignoring auto" >> return botState
        (True, "", _, Just "take numbers-bot") -> do
            let botState' = botState { currentHolder = Just sender }
            sendZephyr botState' $ sender <> " takes numbers-bot"
            return botState'
        (True, "", _, Just "drop numbers-bot") -> do
            let botState' = botState
                    { currentHolder = Nothing
                    , currentClass    = z_class notice
                    , currentInstance = z_instance notice
                    }
            sendZephyr botState' $ sender <> " drops numbers-bot"
            return botState'
        (True, "", _, Just body) ->
            case readMaybe $ B.unpack body of
                Just n -> do
                    d <- randomRIO (-abs n, abs n)
                    let botState' = botState
                            { currentNumber = currentNumber botState + d }
                    zephyrState botState'
                    return botState'
                Nothing -> return botState
        _ -> putStrLn "Ignoring personal" >> return botState
    putMVar botStateMVar nextBotState

main :: IO ()
main = do
    initialize
    subscribeTo [ZSubscription "bpchen" "*" "*",
        ZSubscription "ztoys" "*" "*"]
    putStrLn "Subbed."
    botStateMVar <- newMVar (BotState
        { currentClass = "bpchen"
        , currentInstance = "bot"
        , currentHolder = Nothing
        , currentNumber = 0
        })
    _ <- forkSpontaneityThread botStateMVar
    _ <- forkStdinAdminThread botStateMVar
    foreverListen botStateMVar