linklater (empty) → 1.0.0.0

raw patch · 4 files changed

+248/−0 lines, 4 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, lens, text, wai, wreq

Files

• LICENSE +30/−0
• Network/Linklater.hs +173/−0
• Setup.hs +2/−0
• linklater.cabal +43/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Hao Lian++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Hao Lian nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Network.Linklater+-- Copyright: (c) The Linklaterteers+--+-- License: BSD-style+-- Stability: experimental+-- Portability: GHC+--+-- Features:+--+-- * Uses @Text@ everywhere so you can send your slash commands crazy Unicode characters all day long.+-- * Lovely documentation.+-- * Battle-tested.+--+-- Here's a @/jpgto@ bot! If you run this program and then tell Slack+-- about your server (incoming hook and custom slash command) and then+-- type @/jpgto diplomatico@ in one of your channels, you'll get the+-- image from @http://diplomatico.jpg.to@. How, you say? /Screen scraping/.+--+-- @+-- urlParser :: Parser B.ByteString+-- urlParser = p+--   where+--     p = garbage *> url+--     garbage = string "src=\"" <|> (P.take 1 *> garbage)+--     url = takeTill (== _quotedbl)+--+-- urlFor :: Text -> IO Text+-- urlFor search = do+--   r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search])+--   (return . handle . parse urlParser . strictly) (r ^. responseBody)+--   where+--     strictly = B.concat . L.toChunks+--     handle (Fail i ctxs s) = error (show (i, ctxs, s))+--     handle (Partial f) = handle (f "")+--     handle (Done _ r) = toText r+--+-- jpgto :: Maybe Command -> Application+-- jpgto (Just (Command (User user) channel text)) req respond = do+--   url <- urlFor (maybe "spolsky" id text)+--   say (Message channel (response url) (EmojiIcon "gift")) config+--   (respond . responseLBS status200 headers) ""+--   where+--     response url = F.format "@{} {}" (user, url)+--     config = Config token "trello.slack.com"+--     headers = [("Content-Type", "text/plain")]+--+-- main :: IO ()+-- main = do+--   let port = 80+--   putStrLn (F.format "+ Listening on port {}" [port])+--   run port (slash jpgto)+--    return ()+-- @+--+-- For the full example (since this one is missing a ton of imports),+-- see the @examples/@ directory on GitHub.+--+-- https://github.com/hlian/linklater++module Network.Linklater+       (+         say,+         slash,+         Channel(..),+         User(..),+         Message(..),+         Config(..),+         Command(..),+         Icon(..),+       ) where++import Control.Applicative ((<$>))+import Data.Aeson+import Data.ByteString.Lazy as BSL+import qualified Data.Map as M+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Data.Text.Lazy as TL+import qualified Network.Wai as W+import Network.Wreq hiding (params)++-- | Where slash commands can come from, and where messages can go.+data Channel =+   -- | A public or private group.+    GroupChannel Text+  -- | A private conversation with your best friend (or lover?).+  | IMChannel Text+  deriving (Eq, Ord, Show)++-- | A username: no at-signs, just text!+newtype User = User Text deriving (Eq, Ord, Show)++-- | Incoming HTTP requests to the slash function get parsed into one+-- of these babies.+data Command = Command {+  -- | Who ran your slash command.+  _commandUser :: User,+  -- | Where the person ran your slash command.+  _commandChannel :: Channel,+  -- | Text for the slash command, if any.+  _commandText :: Maybe Text+  } deriving (Eq, Ord, Show)++-- | For example, @":stars2:"@. Future versions should support actual+-- images, I GUESS.+newtype Icon = EmojiIcon Text deriving (Eq, Ord, Show)++-- | Here's how you talk.+data Message = Message {+  -- | You need a channel. It can be a group channel or a private IM.+  -- Alert: if it's a private IM, it'll look like it came from+  -- slackbot (as of writing).+  _messageChannel :: Channel,+  -- | What you want to say. This will be parsed in full (parse=full).+  -- In the future I'll support other forms of parsing, hopefully.+  -- Poke me with a pull request if I forget.+  _messageText :: Text,+  -- | The icon you want your message to appear as.+  _messageIcon :: Icon+  } deriving (Eq, Ord, Show)++instance ToJSON Message where+  toJSON (Message channel text (EmojiIcon emoji)) =+    object [ "channel" .= stringOfChannel channel+           , "icon_emoji" .= TL.concat [":", emoji, ":"]+           , "parse" .= String "full"+           , "username" .= String "jpgtobot"+           , "text" .= text+           ]+    where+      stringOfChannel (GroupChannel c) = TL.concat ["#", c]+      stringOfChannel (IMChannel m) = TL.concat ["@", m]++-- | Like a curiosity about the world, you'll need one of these to say something.+data Config = Config {+  -- | This is the incoming web hook token that Slack gave you. It's usually a long alphanumberic string of garbage.+  _configIncomingHookToken :: Text,+  -- | This is where your Slack account is hosted. For example, 'trello.slack.com'.+  _configHostname :: Text+  }++-- | The 'say' function posts a Message, with a capital M, to Slack.+-- It'll, ahem, need your token first though.+say :: Message -> Config -> IO (Response ByteString)+say message config =+  post (TL.unpack url) (encode message)+  where+    -- TODO: use a URL builder+    url = TL.concat ["https://", _configHostname config, "/services/hooks/incoming-webhook?token=", _configIncomingHookToken config]++-- | A bot server! As if by magic. This acts like a WAI middleware in+-- that you let us wrap around your application.+slash :: (Maybe Command -> W.Application) -> W.Application+slash f req respond = f command req respond+  where+    command = do+      user <- userOf <$> wishFor "user_name"+      channel <- wishFor "channel_name" >>= channelOf user+      let text = wishFor "text"+      return (Command user channel text)+    wishFor key = case M.lookup (key :: Text) params of+      Just (Just "") -> Nothing+      Just (Just value) -> Just value+      _ -> Nothing+    userOf = User . TL.filter (/= '@')+    channelOf (User u) "directmessage" = Just (IMChannel u)+    channelOf _ "privategroup" = Nothing+    channelOf _ c = Just (GroupChannel c)+    params = M.fromList [(toText k, toText <$> v) | (k, v) <- W.queryString req]+    toText = TLE.decodeUtf8 . BSL.fromChunks . return

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,43 @@+-- Initial linklater.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: linklater+version: 1.0.0.0+synopsis: Write bots for your Slack account, and then go to sleep (because it's so easy and late at night)+homepage: https://github.com/hlian/linklater+license: BSD3+license-file: LICENSE+author: Hao Lian+maintainer: me@haolian.org+category: Network+build-type: Simple+cabal-version: >=1.10++description:+  .+  A library for writing <https://slack.com/> Slack chat bots.+  .+  A mistake?++flag developer+  default: True+  manual: True++library+  default-language: Haskell2010+  ghc-options: -Wall -fwarn-tabs+  if flag(developer)+    ghc-options: -Werror++  exposed-modules:+    Network.Linklater++  build-depends:+    base >=4.7 && <4.8,+    wreq >=0.1.0.1 && <0.2,+    lens >=4.3 && <4.4,+    aeson >=0.7.0.6 && <0.8,+    bytestring >=0.10.4.0 && <0.11,+    text >=1.1.1.3 && <1.2,+    containers >=0.5.5.1 && <0.6,+    wai >=3.0.0.2 && <3.1