lambdatwit (empty) → 0.1.0.0
raw patch · 5 files changed
+313/−0 lines, 5 filesdep +MissingHdep +acid-statedep +authenticate-oauthsetup-changed
Dependencies added: MissingH, acid-state, authenticate-oauth, base, bytestring, case-insensitive, conduit, containers, data-default, exceptions, hint, http-conduit, http-types, lens, monad-control, monad-logger, mtl, mueval, network-uri, resourcet, safecopy, text, transformers, transformers-base, twitter-conduit, twitter-types, utf8-string
Files
- LICENSE +20/−0
- Main.hs +155/−0
- Setup.hs +2/−0
- lambdatwit.cabal +74/−0
- oauth_pin.hs +62/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Aaron Ash++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import Control.Applicative+import Control.Concurrent (threadDelay)+import Control.Lens+import Control.Monad (when,forever)+import Control.Monad.Catch (try)+import Control.Monad.IO.Class+import Control.Monad.Logger+import Control.Monad.Reader (ask)+import Control.Monad.State (modify)+import Control.Monad.Trans.Resource+import Data.Acid+import Data.SafeCopy+import Data.String.Utils+import Data.Typeable+import Language.Haskell.Interpreter (runInterpreter)+import Mueval.ArgsParse+import Mueval.Interpreter+import Web.Twitter.Conduit+import Web.Twitter.Types.Lens+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import qualified Data.Text as T+import qualified Data.Text.IO as T++import Tokens+import Common++-- Strip off the first world (which is assumed to be the screenname of the+-- bot).+getHaskellExpression :: T.Text -> T.Text+getHaskellExpression t =+ case T.breakOn " " $ T.strip t of+ (a, "") -> a+ (_, rest) -> T.strip rest++isHaskellPost :: T.Text -> Status -> Bool+isHaskellPost userName status =+ (T.isPrefixOf userName $ status ^. statusText) &&+ (status ^. statusUser ^. userScreenName) /= botScreenName++evalExpr :: String -> IO String+evalExpr e =+ case getOptions ["--expression", e] of+ Left t@(b, e) -> return $ show t+ Right opts -> do+ r <- runInterpreter (interpreter opts)+ case r of+ Left err -> return $ show err+ Right (e,et,val) -> do (out, b) <- getResult val+ return out++getResult :: (Functor m, MonadIO m) => String -> m (String, Bool)+getResult str = render 1024 str++statusToText :: Status -> T.Text+statusToText status = T.concat [ T.pack . show $ status ^. statusId+ , ": "+ , status ^. statusUser . userScreenName+ , ": "+ , status ^. statusText+ ]++evalExpression :: MonadIO m => Status -> m String+evalExpression status = do+ r <- liftIO $ evalExpr $ decodeHtml $ T.unpack $ getHaskellExpression $ status ^. statusText+ return $ take 140 r++{-TODO: Make this more comprehensive-}+decodeHtml :: String -> String+decodeHtml s =+ replace "<" "<" $+ replace ">" ">" $+ replace "&" "&" $+ replace """ "\"" $+ replace "'" "'" $ s++-- res <- call $ update "Hello World"+reply :: Integer -> T.Text -> APIRequest StatusesUpdate Status+reply i s =+ Web.Twitter.Conduit.update s & inReplyToStatusId ?~ i++postreply :: (MonadResource m, MonadLogger m) => Status -> Integer -> String -> TW m Status+postreply status i res = call (reply i $ (T.take 140 $+ T.concat ["@",+ status ^. statusUser ^. userScreenName,+ " ",+ T.pack res]))+++{-Acid State database to keep track of replies-}+data TweetId = TweetId { tweetId :: Integer }+ deriving (Eq, Show, Typeable)+data LambdaTwitDb = LambdaTwitDb { allReplyIds :: [TweetId] }+ deriving (Typeable)++allReplies :: Query LambdaTwitDb [TweetId]+allReplies = allReplyIds <$> ask++addReply :: TweetId -> Update LambdaTwitDb ()+addReply tweetId = modify go+ where go (LambdaTwitDb db) = LambdaTwitDb $ tweetId : db++{-The Acid State magic-}+deriveSafeCopy 0 'base ''TweetId+deriveSafeCopy 0 'base ''LambdaTwitDb+makeAcidic ''LambdaTwitDb ['allReplies, 'addReply]++conduitmain :: IO ()+conduitmain = do+ state <- openLocalState (LambdaTwitDb [])+ forever $ do+ {-TODO: Use Data.Configurator to read in the oauth keys without needing a recompile:+ - http://hackage.haskell.org/package/configurator-}+ runNoLoggingT . runTwitterFromEnv $ do+ sourceWithMaxId mentionsTimeline+ C.$= CL.isolate 100+ C.$$ CL.mapM_ $ \status -> do+ replies <- liftIO $ query state AllReplies+ if ((TweetId (status ^. statusId)) `elem` replies)+ then do+ liftIO $ putStrLn "Already replied to:"+ liftIO $ T.putStrLn $ statusToText status+ liftIO $ threadDelay $ 60 * 1000000+ else do+ when (isHaskellPost botScreenName status) $ do+ liftIO $ T.putStrLn $ statusToText status+ res <- evalExpression status+ liftIO $ putStrLn res+ postres <- try $ postreply status (status ^. statusId) res+ case postres of+ Left (FromJSONError e) -> liftIO $ print e+ Left (TwitterErrorResponse s resH errs) ->+ liftIO $ print errs+ Left (TwitterStatusError s resH val) ->+ liftIO $ print val+ Right status -> liftIO $ print $ statusToText status+ liftIO $ Data.Acid.update state (AddReply $ TweetId (status ^. statusId))+ -- AA TODO: Better rate limiting, this probably blocks every tweet.+ -- We should only wait for 60 seconds after each mentionsTimeline grab+ liftIO $ threadDelay $ 60 * 1000000++main :: IO ()+main = conduitmain++{-TODO: Import lens:-}+{-https://twitter.com/relrod6/status/516785803100688384-}+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lambdatwit.cabal view
@@ -0,0 +1,74 @@+-- Initial lambdatwit.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: lambdatwit+version: 0.1.0.0+synopsis: Lambdabot running as a twitter bot. Similar to the @fsibot f# bot.+description: A twitter bot using mueval to evaluate haskell tweets.+ Further info: <https://github.com/AshyIsMe/lambdatwit/blob/master/README.md>+license: MIT+license-file: LICENSE+author: Aaron Ash+maintainer: aaron.ash@gmail.com+homepage: http://github.com/ashyisme/lambdatwit+bug-reports: https://github.com/ashyisme/lambdatwit/issues+-- copyright: +category: Web+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/ashyisme/lambdatwit.git++executable lambdatwit+ main-is: Main.hs+ build-depends: base + , acid-state+ , authenticate-oauth+ , bytestring+ , case-insensitive+ , conduit+ , containers+ , data-default+ , exceptions+ , hint+ , http-conduit+ , lens+ , MissingH+ , monad-control+ , monad-logger+ , mtl+ , mueval+ , network-uri+ , resourcet+ , safecopy+ , text+ , transformers == 0.3.0.0+ , transformers-base+ , twitter-conduit+ , twitter-types+ , utf8-string++ -- hs-source-dirs: + default-language: Haskell2010++executable oauth_pin+ main-is: oauth_pin.hs++ build-depends:+ base >= 4.5 && < 5+ , containers+ , transformers-base+ , transformers+ , monad-control+ , bytestring+ , text+ , resourcet+ , conduit+ , http-types+ , http-conduit+ , authenticate-oauth+ , twitter-conduit+ default-language: Haskell2010
+ oauth_pin.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}++-- Example:+-- $ export OAUTH_CONSUMER_KEY="your consumer key"+-- $ export OAUTH_CONSUMER_SECRET="your consumer secret"+-- $ runhaskell oauth_pin.hs++module Main where++import Web.Twitter.Conduit hiding (lookup)+import Web.Authenticate.OAuth as OA+import Network.HTTP.Conduit+import qualified Data.Conduit as C+import qualified Data.ByteString.Char8 as S8+import Data.Maybe+import Data.Monoid+import Control.Monad.Trans.Control+import Control.Monad.Trans.Resource+import Control.Monad.IO.Class+import System.Environment+import System.IO (hFlush, stdout)++getTokens :: IO OAuth+getTokens = do+ consumerKey <- getEnv "OAUTH_CONSUMER_KEY"+ consumerSecret <- getEnv "OAUTH_CONSUMER_SECRET"+ return $+ twitterOAuth+ { oauthConsumerKey = S8.pack consumerKey+ , oauthConsumerSecret = S8.pack consumerSecret+ , oauthCallback = Just "oob"+ }++authorize :: (MonadBaseControl IO m, MonadResource m)+ => OAuth -- ^ OAuth Consumer key and secret+ -> Manager+ -> m Credential+authorize oauth mgr = do+ cred <- OA.getTemporaryCredential oauth mgr+ let url = OA.authorizeUrl oauth cred+ pin <- getPIN url+ OA.getAccessToken oauth (OA.insert "oauth_verifier" pin cred) mgr+ where+ getPIN url = liftIO $ do+ putStrLn $ "browse URL: " ++ url+ putStr "> what was the PIN twitter provided you with? "+ hFlush stdout+ S8.getLine++main :: IO ()+main = do+ tokens <- getTokens+ Credential cred <- liftIO $ withManager $ authorize tokens+ print cred++ S8.putStrLn . S8.intercalate "\n" $+ [ "export OAUTH_CONSUMER_KEY=\"" <> oauthConsumerKey tokens <> "\""+ , "export OAUTH_CONSUMER_SECRET=\"" <> oauthConsumerSecret tokens <> "\""+ , "export OAUTH_ACCESS_TOKEN=\"" <> fromMaybe "" (lookup "oauth_token" cred) <> "\""+ , "export OAUTH_ACCESS_SECRET=\"" <> fromMaybe "" (lookup "oauth_token_secret" cred) <> "\""+ ]