Permalink
Browse files

Merge branch 'master' of ssh://github.com/Detegr/HBot

  • Loading branch information...
2 parents ccbc310 + 5ba9639 commit 69fbdde9cc9b2c57caa7bb9bf5f65f4243ec2e04 @Detegr committed Mar 4, 2014
Showing with 87 additions and 20 deletions.
  1. +1 −1 Makefile
  2. +46 −0 Plugin/DogeTip.hs
  3. +30 −15 Plugin/Trivia.hs
  4. +2 −2 Plugin/Unicafe.hs
  5. +8 −2 Plugin/UrlAnalyzer.hs
View
@@ -1,6 +1,6 @@
SRC=HBot
CSRC=Config/config.c
-PLUGINNAMES=Admin Wikla Unicafe Random Random3 Lanit Arabianranta Util/Random Util/DatabasePath UrlAnalyzer Help Logger Trivia
+PLUGINNAMES=Admin Wikla Unicafe Random Random3 Lanit Arabianranta Util/Random Util/DatabasePath UrlAnalyzer Help Logger Trivia DogeTip
PLUGINS=$(addprefix Plugin/,$(PLUGINNAMES))
PLUGINOBJECTS=$(addsuffix .o,$(PLUGINS))
COBJECTS=$(CSRC:.c=.o)
View
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+
+module Plugin.Doge where
+
+import PluginData
+import Plugin.Util.DogeTipUserDetails
+import Network.Bitcoin
+import Network.Bitcoin.Wallet
+import Data.Text hiding (head, length, map, tail)
+import qualified Data.Text.IO as TIO
+import Safe (readMay)
+import Control.Exception
+
+auth :: Auth
+auth = Auth "http://127.0.0.1:22555" user password
+
+(!!!) :: [a] -> Int -> Maybe a
+(!!!) xs i = if length xs > i then Just $ xs !! i else Nothing
+
+dogetip :: PluginData a -> IO (PluginResult a)
+dogetip pd = do
+ if length (arguments pd) > 0 then
+ case (head . arguments $ pd) of
+ "receive" -> do
+ addr <- getNewAddress auth (Just $ pack . getNick $ pd)
+ msgToChannel pd $ "plz receive (" ++ getNick pd ++ "): " ++ (unpack addr)
+ "send" -> do
+ let sendargs = map pack (tail . arguments $ pd)
+ if length sendargs < 2
+ then msgToChannel pd $ "Usage: !doge send <address> <amount> [comment] [who is the receiver]"
+ else
+ case readMay $ unpack (sendargs !! 1) of
+ Nothing -> msgToChannel pd $ "plz fix amount"
+ Just amount -> do
+ mbta <- try $ sendFromAccount auth (pack . getNick $ pd) (sendargs !! 0) amount (sendargs !!! 2) (sendargs !!! 3) :: IO (Either BitcoinException TransactionID)
+ msgToChannel pd $ case mbta of
+ Left err -> "much transaction, no doge"
+ Right ta -> "wow, such doge (" ++ unpack ta ++ ")"
+ "balance" -> do
+ mbb <- try $ getBalance' auth (pack . getNick $ pd) :: IO (Either BitcoinException BTC)
+ msgToChannel pd $ case mbb of
+ Left err -> "omg. no doge account. plz '!doge receive' first."
+ Right b -> "such wow, much doge (" ++ getNick pd ++ "): " ++ show b
+ _ -> do msgsToNick pd ["much doge. to the moon!", "!doge receive", "!doge send <address> <amount> [comment] [who is the receiver]", "!doge balance"]
+ else
+ msgsToNick pd ["much doge. to the moon!", "!doge receive", "!doge send <address> <amount> [comment] [who is the receiver]", "!doge balance"]
View
@@ -3,6 +3,8 @@ module Plugin.Util.Trivia(trivia) where
import PluginData
import Plugin.Util.Random
import Data.Char (toLower)
+import qualified Data.HashMap as H
+import Data.String.Utils (strip)
parseUserAndMessage :: String -> (String, String)
parseUserAndMessage s = (parseUser s, parseMessage s)
@@ -16,31 +18,44 @@ parseUser = takeWhile (/= '>') . tail . dropWhile (/= '<')
question :: String
question = "Guess the author of this line: "
-correct :: String -> String -> String
-correct w u = "The winner is " ++ w ++ ", that line was written by " ++ u ++ "."
+correct :: String -> String -> H.Map String Int -> String
+correct w u m = "The winner is " ++ w ++ "(" ++ (show (m H.! w)) ++ "), that line was written by " ++ u ++ "."
incorrect :: String
incorrect = "Nope."
cancel :: String -> String
cancel u = "Cancelling trivia, the correct answer was: " ++ u
-trivia :: PluginData (String, String) -> IO (PluginResult (String, String))
+addPoints :: H.Map String Int -> String -> Int -> H.Map String Int
+addPoints m u p =
+ if H.member u m
+ then H.insert u ((m H.! u)+p) m
+ else H.insert u p m
+
+type TriviaData = (Maybe (String, String), H.Map String Int)
+
+trivia :: PluginData TriviaData -> IO (PluginResult TriviaData)
trivia pd = do
if (head $ head (params pd)) /= '#'
then msgTo (getNick pd) "Dude, leave me alone!" (state pd)
else do
let a = arguments pd
case (state pd) of
- Just (u,msg) ->
- if length a > 0
- then if (map toLower (head a) == map toLower u)
- then msgToChannel' pd (correct (getNick pd) u) Nothing
- else msgToChannel' pd incorrect (state pd)
- else msgToChannel' pd (cancel u) Nothing
- Nothing ->
- if length a > 0
- then msgToChannel' pd "Launch trivia without arguments." Nothing
- else do
- (u,msg) <- fmap parseUserAndMessage $ getRandom Nothing
- msgToChannel' pd (question ++ msg) $ Just (u,msg)
+ Just (mbu,points) ->
+ case mbu of
+ Just (u,msg) ->
+ if length a > 0
+ then if (map toLower (strip . head $ a) == map toLower u)
+ then do
+ let newpoints=addPoints points (getNick pd) 1
+ msgToChannel' pd (correct (getNick pd) u newpoints) $ Just (Nothing, newpoints)
+ else msgToChannel' pd incorrect $ Just (Just (u,msg), addPoints points (getNick pd) (-1))
+ else msgToChannel' pd (cancel u) $ Just (Nothing, points)
+ Nothing ->
+ if length a > 0
+ then msgToChannel' pd "Launch trivia without arguments." $ Just (Nothing, points)
+ else do
+ (u,msg) <- fmap parseUserAndMessage $ getRandom Nothing
+ msgToChannel' pd (question ++ msg) $ Just (Just (u,msg), points)
+ Nothing -> trivia ((host pd), (params pd), (arguments pd), Just (Nothing, H.empty))
View
@@ -107,8 +107,8 @@ foodParser = do
many $ noneOf ")"
char ')'
return () <|> eof
- t <- try $ string "Maukkaasti" <|> string "Edullisesti" <|> string "Kevyesti"
- return $ T.concat [(T.pack f), (T.pack "- "), (T.pack t)]
+ t <- try $ string "Edullisesti" <|> string "Kevyesti"
+ return $ T.pack f --T.concat [(T.pack f), (T.pack "- "), (T.pack t)]
joinFoodAndType :: [T.Text] -> [T.Text]
View
@@ -16,9 +16,15 @@ import Data.String.Utils (strip)
import PluginData
+userAgent :: B.ByteString
+userAgent = "Mozilla/5.0 (Windows NT 6.2; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/32.0.1667.0 Safari/537.36"
+
getTitle :: String -> IO String
-getTitle uri = do
- src <- simpleHttp uri
+getTitle url = do
+ src <- withManager $ \m -> do
+ req' <- parseUrl url
+ let req = req' { requestHeaders = (requestHeaders req') ++ [("User-agent", userAgent)] }
+ fmap responseBody $ httpLbs req m
let mbtitle=(map T.unpack .
map fromTagText .
filter isTagText .

0 comments on commit 69fbdde

Please sign in to comment.