packages feed

werewolf-slack 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+269/−48 lines, 9 filesdep +mtldep +optparse-applicative

Dependencies added: mtl, optparse-applicative

Files

CHANGELOG.md view
@@ -2,8 +2,27 @@  ### Upcoming +### v0.2.0.0++*Major*++* Added options for specifying the Slack access token, channel name and port to run the server on. ([#6](https://github.com/hjwylde/werewolf/issues/6))++*Minor*++* Added a `--validation-token` option and validation. ([#9](https://github.com/hjwylde/werewolf/issues/9))+* Added a `--debug` flag. ([#4](https://github.com/hjwylde/werewolf/issues/4))++*Revisions*++* Fingers crossed fixed a bug with UTF-8 parsing of an accented e. ([#10](https://github.com/hjwylde/werewolf/issues/10))+ ### v0.1.0.0  *Major*  * Initial version that connects Slack with the werewolf binary. ([#1](https://github.com/hjwylde/werewolf/issues/1))++*Minor*++* Added a Dockerfile. ([#5](https://github.com/hjwylde/werewolf/issues/5))
README.md view
@@ -4,7 +4,8 @@ [![Build Status](https://travis-ci.org/hjwylde/werewolf-slack.svg?branch=master)](https://travis-ci.org/hjwylde/werewolf-slack) [![Release](https://img.shields.io/github/release/hjwylde/werewolf-slack.svg)](https://github.com/hjwylde/werewolf-slack/releases/latest) -A Slack chat client for playing [werewolf](https://github.com/hjwylde/werewolf).+A chat interface for playing [werewolf](https://github.com/hjwylde/werewolf) in+    [Slack](https://slack.com/). The game engine is based off of the party game Mafia, also known as Werewolf. See the [Wikipedia article](https://en.wikipedia.org/wiki/Mafia_(party_game)) for a rundown on it's     gameplay and history.@@ -18,19 +19,39 @@ Each night Werewolves attack the village and devour the innocent. For centuries no one knew how to fight this scourge, however recently a theory has taken ahold     that-    maphaps the Werewolves walk among the Villagers themselves...+    mayhaps the Werewolves walk among the Villagers themselves...  Objective of the Game:   For the Loners: complete their own objective.   For the Villagers: lynch all of the Werewolves.   For the Werewolves: devour all of the Villagers. -### Installing+### Setup +#### Preparing Slack++Set up an Incoming WebHook [here](https://my.slack.com/services/new/incoming-webhook/).+Make note of the *access token*, we'll be using that soon.++Set up a Slash Command (`/werewolf` or similar)+    [here](https://my.slack.com/services/new/slash-commands/).+The Slash Command should perform a GET request to the server werewolf-slack is going to be hosted+    on.+Make note of the *validation token* here too.++#### Installing+ Installing werewolf-slack is easiest done using either-    [stack](https://github.com/commercialhaskell/stack) (recommended) or+    [Docker](https://www.docker.com/) (recommended),+    [stack](https://github.com/commercialhaskell/stack) or     [Cabal](https://github.com/haskell/cabal). +**Using Docker:**++```bash+docker pull hjwylde/werewolf-slack+```+ **Using stack:**  ```bash@@ -45,8 +66,37 @@ export PATH=$PATH:~/.cabal/bin ``` -### Usage+#### Running -#### Commands+werewolf-slack is a simple web server that listens for events from the Slack Slash Command.+After receiving an event werewolf-slack forwards it on to the werewolf game engine and uses the+    Incoming WebHook to send back the response. -See `/werewolf help`.+Running werewolf-slack is easiest done using either+    [Docker](https://www.docker.com/) (recommended) or+    the binary itself.+Make sure to add rules to your firewall for werewolf-slack's port.++**With Docker:**++```bash+docker run -d -p 80:8080 hjwylde/werewolf-slack -t ACCESS_TOKEN -v VALIDATION_TOKEN+```++**With werewolf-slack:**++```bash+werewolf-slack -p 80 -t ACCESS_TOKEN -v VALIDATION_TOKEN &+```++#### Configuration++It is possible to also configure the channel to play werewolf in and the port that werewolf-slack+    listens on.+This is done via the `--channel-name` (`-c`) and `--port` (`-p`) options respectively.++By default the channel name is *werewolf* and port *8080*.++### Usage++Type `/werewolf help` in your Slack channel to get going!
app/Main.hs view
@@ -11,9 +11,20 @@     main, ) where +import Control.Monad.Reader++import Options.Applicative+ import System.Environment  import Werewolf.Slack.Application+import Werewolf.Slack.Options  main :: IO ()-main = getArgs >>= runApplication+main = getArgs >>= run++run :: [String] -> IO ()+run args = handleParseResult (execParserPure werewolfSlackPrefs werewolfSlackInfo args) >>= handle++handle :: Options -> IO ()+handle = runReaderT runApplication
app/Werewolf/Slack/Application.hs view
@@ -6,7 +6,9 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}  module Werewolf.Slack.Application (     -- * Application@@ -15,30 +17,45 @@  import Control.Concurrent import Control.Monad.Extra+import Control.Monad.Reader+import Control.Monad.State  import qualified Data.ByteString.Char8      as BSC import qualified Data.ByteString.Lazy.Char8 as BSLC import           Data.Maybe -import Network.HTTP.Types       (status202, status400)+import Network.HTTP.Client      hiding (queryString)+import Network.HTTP.Client.TLS+import Network.HTTP.Types import Network.Wai              hiding (Response, requestBody, responseStatus) import Network.Wai.Handler.Warp +import Werewolf.Slack.Options import Werewolf.Slack.Werewolf -runApplication :: [String] -> IO ()-runApplication args = run port (application args)-    where-        port = 8080+runApplication :: (MonadIO m, MonadReader Options m) => m ()+runApplication = do+    options <- ask -application :: [String] -> Application-application args request respond = maybe failure (\action -> forkIO action >> success) mAction+    manager <- liftIO $ newManager tlsManagerSettings++    liftIO $ run (optPort options) (application options manager)++application :: Options -> Manager -> Application+application options manager request respond+    | isNothing mToken                              = debugRequest >> badRequest+    | fromJust mToken /= optValidationToken options = debugRequest >> unauthorized+    | isNothing mUser || isNothing mUserCommand     = debugRequest >> badRequest+    | otherwise                                     = debugRequest >> forkIO (evalStateT (runReaderT action options) manager) >> accepted     where-        failure = respond $ responseLBS status400 [] "bad request"-        success = respond $ responseLBS status202 [] (BSLC.pack $ fromJust mUserCommand)+        debugRequest = when (optDebug options) $ print request +        accepted        = respond $ responseLBS status202 [] (BSLC.pack $ unwords [":wolf:", fromJust mUserCommand, ":moon:"])+        badRequest      = respond $ responseLBS status400 [] "bad request"+        unauthorized    = respond $ responseLBS status401 [] "unauthorized"+         param name      = join . lookup name $ queryString request-        accessToken     = head args+        mToken          = BSC.unpack <$> param "token"         mUser           = BSC.unpack <$> param "user_name"         mUserCommand    = BSC.unpack <$> param "text"-        mAction         = executeUserCommand accessToken <$> mUser <*> mUserCommand+        action          = fromJust $ execute <$> mUser <*> mUserCommand
+ app/Werewolf/Slack/Options.hs view
@@ -0,0 +1,81 @@+{-|+Module      : Werewolf.Slack.Options+Description : Optparse utilities.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Optparse utilities.+-}++module Werewolf.Slack.Options (+    -- * Options+    Options(..),++    -- * Optparse+    werewolfSlackPrefs, werewolfSlackInfo, werewolfSlack,+) where++import Data.Version (showVersion)++import Network.Wai.Handler.Warp++import Options.Applicative++import qualified Werewolf.Slack.Version as This++data Options = Options+    { optAccessToken     :: String+    , optChannelName     :: String+    , optDebug           :: Bool+    , optPort            :: Port+    , optValidationToken :: String+    } deriving (Eq, Show)++-- | The default preferences.+--   Limits the help output to 100 columns.+werewolfSlackPrefs :: ParserPrefs+werewolfSlackPrefs = prefs $ columns 100++-- | An optparse parser of a werewolf-slack command.+werewolfSlackInfo :: ParserInfo Options+werewolfSlackInfo = info (infoOptions <*> werewolfSlack) (fullDesc <> header' <> progDesc')+    where+        infoOptions = helper <*> version+        version     = infoOption ("Version " ++ showVersion This.version) $ mconcat+            [ long "version", short 'V', hidden+            , help "Show this binary's version"+            ]++        header'     = header "A Slack chat interface for playing werewolf."+        progDesc'   = progDesc+            "The game engine is based off of the party game Mafia, also known as Werewolf."++-- | An options parser.+werewolfSlack :: Parser Options+werewolfSlack = Options+    <$> strOption (mconcat+        [ long "access-token", short 't', metavar "TOKEN"+        , help "Specify the access token"+        ])+    <*> strOption (mconcat+        [ long "channel-name", short 'c', metavar "CHANNEL"+        , value "werewolf", showDefault+        , help "Specify the channel name"+        ])+    <*> switch (mconcat+        [ long "debug", short 'd'+        , help "Enable debug mode"+        ])+    <*> portOption (mconcat+        [ long "port", short 'p', metavar "NAT"+        , value 8080, showDefault+        , help "Specify the port for the server to listen on"+        ])+    <*> strOption (mconcat+        [ long "validation-token", short 'v', metavar "TOKEN"+        , help "Specify the validation token"+        ])+    where+        portOption = option auto
app/Werewolf/Slack/Slack.hs view
@@ -6,37 +6,44 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}  module Werewolf.Slack.Slack (     -- * Slack     notify, ) where -import Control.Monad+import Control.Monad.Extra+import Control.Monad.Reader+import Control.Monad.State -import           Data.Aeson-import qualified Data.Text  as T+import Data.Aeson  import Network.HTTP.Client-import Network.HTTP.Client.TLS import Network.HTTP.Types.Method -url :: String -> String-url accessToken = "https://hooks.slack.com/services/" ++ accessToken+import Werewolf.Slack.Options -notify :: String -> String -> String -> IO ()-notify accessToken to message = do-    manager <- newManager tlsManagerSettings+url :: MonadReader Options m => m String+url = asks $ ("https://hooks.slack.com/services/" ++) . optAccessToken -    initialRequest  <- parseUrl $ url accessToken+notify :: (MonadIO m, MonadReader Options m, MonadState Manager m) => String -> String -> m ()+notify to message = do+    manager <- get++    initialRequest  <- url >>= liftIO . parseUrl     let request     = initialRequest { method = methodPost, requestBody = body } -    void $ httpLbs request manager+    whenM (asks optDebug) $ liftIO (print request)++    response <- liftIO $ httpLbs request manager++    whenM (asks optDebug) $ liftIO (print response)     where         body    = RequestBodyLBS $ encode payload         payload = object             [ "channel" .= to             , "text" .= message-            , "icon_emoji" .= T.unpack ":wolf:"             ]
+ app/Werewolf/Slack/Version.hs view
@@ -0,0 +1,17 @@+{-|+Module      : Werewolf.Slack.Version+Description : Haskell constant of the binary version.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Haskell constant of the binary version.+-}++module Werewolf.Slack.Version (+    -- * Version+    version,+) where++import Paths_werewolf_slack (version)
app/Werewolf/Slack/Werewolf.hs view
@@ -6,36 +6,51 @@ Maintainer  : public@hjwylde.com -} +{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+ module Werewolf.Slack.Werewolf (     -- * Werewolf-    executeUserCommand,+    execute, ) where  import Control.Monad.Extra+import Control.Monad.Reader+import Control.Monad.State  import           Data.Aeson-import qualified Data.ByteString.Lazy.Char8 as BSLC import           Data.Maybe-import qualified Data.Text                  as T+import qualified Data.Text               as T+import qualified Data.Text.Lazy          as TL+import           Data.Text.Lazy.Encoding  import Game.Werewolf +import Network.HTTP.Client hiding (Response)+ import System.Process +import Werewolf.Slack.Options import Werewolf.Slack.Slack -executeUserCommand :: String -> String -> String -> IO ()-executeUserCommand accessToken user userCommand = do-    stdout          <- readCreateProcess (proc command arguments) ""-    let mResponse   = decode (BSLC.pack stdout) :: Maybe Response+execute :: (MonadIO m, MonadReader Options m, MonadState Manager m) => String -> String -> m ()+execute user userCommand = whenJustM (interpret user userCommand) handle -    whenJust mResponse $ \response ->-        forM_ (messages response) $ \(Message mTo message) ->-            notify accessToken (fromMaybe channelName (T.unpack <$> mTo)) (T.unpack message)+interpret :: MonadIO m => String -> String -> m (Maybe Response)+interpret user userCommand = do+    stdout <- liftIO $ readCreateProcess (proc command arguments) ""++    return (decode (encodeUtf8 $ TL.pack stdout) :: Maybe Response)     where         atUser      = if take 1 user == "@" then user else '@':user         command     = "werewolf"         arguments   = ["--caller", atUser, "interpret", "--"] ++ words userCommand -channelName :: String-channelName = "#werewolf"+handle :: (MonadIO m, MonadReader Options m, MonadState Manager m) => Response -> m ()+handle response = do+    whenM (asks optDebug) $ liftIO (print response)++    channelName <- asks $ ('#':) . optChannelName++    forM_ (messages response) $ \(Message mTo message) ->+        notify (fromMaybe channelName (T.unpack <$> mTo)) (T.unpack message)
werewolf-slack.cabal view
@@ -1,13 +1,12 @@ name:           werewolf-slack-version:        0.1.0.0+version:        0.2.0.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com homepage:       https://github.com/hjwylde/werewolf-slack -synopsis:       A Slack chat client for playing werewolf (https://github.com/hjwylde/werewolf)+synopsis:       A Slack chat client for playing werewolf description:    The game engine is based off of the party game Mafia, also known as Werewolf.-                See https://github.com/hjwylde/werewolf-slack for help on running the chat client.  license:        BSD3 license-file:   LICENSE@@ -27,8 +26,11 @@     hs-source-dirs: app/     ghc-options:    -threaded -with-rtsopts=-N     other-modules:+        Paths_werewolf_slack         Werewolf.Slack.Application+        Werewolf.Slack.Options         Werewolf.Slack.Slack+        Werewolf.Slack.Version         Werewolf.Slack.Werewolf      default-language: Haskell2010@@ -40,6 +42,8 @@         http-client == 0.4.*,         http-client-tls == 0.2.*,         http-types == 0.9.*,+        mtl == 2.2.*,+        optparse-applicative == 0.12.*,         process == 1.2.*,         text == 1.2.*,         wai == 3.2.*,