wwwww/h-irc-bot
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

new structure

Browse Source
This commit is contained in:
wwwww 2020-03-14 04:44:34 +03:00
parent bd9bb0d226
commit c79620ff2b
17 changed files with 394 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
README.md
View File

@ -1 +1,7 @@
# haskell-basic-irc-bot
## doc
example.json > .connection.json than you are ready to go

10
app/Main.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
import IrcBot.IrcBot as I
import IrcBot.JsonConfigDecoder
@ -7,8 +7,9 @@ import qualified Data.ByteString.Lazy as C
import Data.Aeson
import Data.Maybe
import qualified Control.Concurrent as T
import IrcBot.Definitions.Options
import IrcBot.Definitions.ServerAddress
import Control.Lens
initWithOptions:: Maybe IOptions -> IO()
@ -25,6 +26,9 @@ mainLoop = do
T.threadDelay 1000000
mainLoop
makeLenses ''IServerAddress
main :: IO ()
main = do

5
example.json
View File

@ -1,10 +1,14 @@
{
"admins": [
"testnick"
],
"servers": [
{
"server": "irc.freenode.net",
"port": 6697,
"ssl": true,
"nickname": "hBotTest1",
"password": "password",
"channels": [
"#123123123123_test_channel"
]
@ -14,6 +18,7 @@
"port": 6697,
"ssl": true,
"nickname": "hBotTest",
"password": "password",
"channels": [
"#123123123123_test_channel1"
]

8
haskell-basic-irc-bot.cabal
View File

@ -36,6 +36,10 @@ library
, IrcBot.IrcBot
, IrcBot.RandomFileFinder
, IrcBot.BotCustomCommands
, IrcBot.Definitions.ServerResponse
, IrcBot.Definitions.ServerAddress
, IrcBot.Definitions.Options
, IrcBot.Config.ConfigHelper
other-modules:
Paths_haskell_basic_irc_bot
hs-source-dirs:
@ -52,6 +56,8 @@ library
, json
, aeson
, MissingH
, split
, lens
default-language: Haskell2010
executable haskell-basic-irc-bot-exe
@ -72,6 +78,8 @@ executable haskell-basic-irc-bot-exe
, connection
, json
, aeson
, split
, lens
default-language: Haskell2010
test-suite haskell-basic-irc-bot-test

101
src/IrcBot/BotActions.hs
View File

@ -10,34 +10,80 @@ import IrcBot.BotNetwork
import IrcBot.BotNetworkCommands
import IrcBot.MessageParser
import IrcBot.BotCustomCommands
import IrcBot.Definitions.ServerResponse
import IrcBot.Definitions.ServerAddress
import qualified Data.ByteString.Lazy as L
import IrcBot.Definitions.Options
import qualified Data.Aeson as A
import Data.Maybe
import qualified Data.List as DL
messageParse:: Connection -> C.ByteString -> IO()
-- its kind of interface for actionFunctions
callActionFunction :: (IServerResponse -> IO()) -> IServerResponse -> IO ()
callActionFunction myFunc parameter1 = myFunc parameter1
messageParse sock stringData =
do
callByMethodDefinition :: MethodDefinition -> Connection -> IServerResponse -> IO ()
callByMethodDefinition methodDefinition sock serverResponse = do
let commandCallerString = (callerString methodDefinition)
let commandMethod = (callableFunction methodDefinition)
if hasStringExist commandCallerString (readDataByteString serverResponse) && (commandType methodDefinition) /= NON_RETURN_ACTION then
do
resultString <- commandMethod serverResponse
writeToSocket sock resultString
else if hasStringExist commandCallerString (C.pack (messageType serverResponse)) && (commandType methodDefinition) == NON_RETURN_ACTION then
do
resultString <- commandMethod serverResponse
writeToSocket sock resultString
else
print "COMMAND DOESNT EXIST"
createServerReponse :: C.ByteString -> IServerAddress -> IO IServerResponse
createServerReponse stringData serverAddress =
do
let unpackedByteString = C.unpack stringData
let debugData = "READ DATA FROM SOCKET: " ++ unpackedByteString
print debugData
let messageParsedMeta = words $ parseMessageMeta unpackedByteString
let messageType = parseMessageType messageParsedMeta
print messageParsedMeta
let userNick = parseNick unpackedByteString
let channelName = parseChannelName unpackedByteString
-- let targetNick = parseMessageTargetFromMeta messageParsedMeta
let messageText = parseMessageText unpackedByteString
let newServerResponse = IServerResponse {
readDataString = unpackedByteString,
readDataByteString = stringData,
sock = sock,
channelName = channelName,
nick = userNick,
messageText = messageText
}
mapM (\x -> callActionFunction (x) newServerResponse) (methods myMethodList)
let d = "PARSE PURSE MESASGE: " ++ messageText
print d
print debugData
let target = targetDeterminer userNick channelName
return $ IServerResponse {
serverName = (server serverAddress),
readDataString = unpackedByteString,
readDataByteString = stringData,
channelName = channelName,
nick = userNick,
messageText = messageText,
messageTarget = target,
messageType = messageType
}
messageParse :: Connection -> C.ByteString -> IServerAddress -> IO()
messageParse sock stringData serverAddress =
do
newServerResponse <- createServerReponse stringData serverAddress
determineSockOutputOperation sock newServerResponse
-- mapM (\x -> callActionFunction (x) newServerResponse) (methods myMethodList)
-- if | hasStringExist "PING " stringData -> pong sock unpackedByteString
-- | hasStringExist ".sup" stringData -> sendMessage sock channelName ("sup " ++ userNick)
-- | hasStringExist " KICK #" stringData -> joinChannel sock channelName >> {-- auto connect in case of kick --} sendMessage sock channelName "fuck you"
@ -46,18 +92,35 @@ messageParse sock stringData =
-- | hasStringExist ".leave" stringData -> disconnectFromChannel sock channelName
-- | otherwise -> print "NO CONDITION FOUND TO PARSE"
determineSockOutputOperation :: Connection -> IServerResponse -> IO ()
determineSockOutputOperation sock newServerResponse = do
output <- L.readFile ".connection.json"
let option = fromJust (A.decode output :: Maybe IOptions)
if elem (nick newServerResponse) (admins option)
then do
mapM (\x -> callByMethodDefinition x sock newServerResponse) (methods myAdminMethodList)
mapM (\x -> callByMethodDefinition x sock newServerResponse) (methods myMethodList)
print "command from admin"
else do
mapM (\x -> callByMethodDefinition x sock newServerResponse) (methods myMethodList)
print "command from normal user"
connectToServer :: String -> PortNumber -> Bool -> IO Connection
connectToServer server port ssl = do
open server port ssl
connectionLoop :: Connection -> IO Connection
connectionLoop sock =
connectionLoop :: Connection -> IServerAddress -> IO Connection
connectionLoop sock serverAddress =
do
stringData <- readFromSocket sock
messageParse sock stringData
messageParse sock stringData serverAddress
case stringData == C.empty of
False -> do
connectionLoop sock
connectionLoop sock serverAddress
True -> do
return sock

116
src/IrcBot/BotCustomCommands.hs
View File

@ -7,22 +7,26 @@ import qualified Data.ByteString.Char8 as C
import IrcBot.BotNetwork
import IrcBot.BotNetworkCommands
import IrcBot.MessageParser
import Data.List.Split
import Data.Maybe
import IrcBot.Definitions.ServerResponse
import IrcBot.Definitions.Options
import IrcBot.Definitions.ServerAddress
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as L
import IrcBot.JsonConfigDecoder
import GHC.Generics
import IrcBot.Config.ConfigHelper
import System.IO
import System.Directory
data IServerResponse = IServerResponse
{
readDataString :: String,
readDataByteString :: C.ByteString,
sock :: Connection,
channelName :: String,
nick :: String,
messageText :: String
}
data MethodList = MethodList { methods :: [IServerResponse -> IO()]}
data MethodList = MethodList { methods :: [MethodDefinition]}
hasStringExist:: String -> C.ByteString -> Bool
hasStringExist :: String -> C.ByteString -> Bool
hasStringExist search source =
do
let byteStringSearch = C.pack search
@ -30,43 +34,91 @@ hasStringExist search source =
basicEcho :: IServerResponse -> IO ()
basicEcho :: IServerResponse -> IO String
basicEcho serverResponse = do
if | hasStringExist ".echo" (readDataByteString serverResponse) -> sendMessage (sock serverResponse) (channelName serverResponse) "EXAMPLE MESSAGE"
| otherwise -> print "NO CONDITION FOUND TO PARSE"
return $ prepareSendMessage (messageTarget serverResponse) "EXAMPLE MESSAGE"
ping :: IServerResponse -> IO ()
ping :: IServerResponse -> IO String
ping serverResponse = do
if | hasStringExist "PING " (readDataByteString serverResponse) -> pong (sock serverResponse) (readDataString serverResponse)
| otherwise -> print "NO CONDITION FOUND TO PARSE"
return $ preparePong (readDataString serverResponse)
join :: IServerResponse -> IO String
join serverResponse = do
let splittedData = splitOn " " (messageText serverResponse)
output <- L.readFile ".connection.json"
let option = fromJust (A.decode output :: Maybe IOptions)
let myServers = (servers option)
let targetChannelName = (splittedData!!1)
result <- mapM (\x -> if (serverName serverResponse) == (server x) then return $ x { channels = ((channels x) ++ [targetChannelName]) } else return x ) (myServers)
-- let newConnectionJson = IOptions { servers = myServers }
-- writeConfigFile newConnectionJson
writeConfigFile option result
return $ prepareJoinChannel (channelName serverResponse)
autoconnect :: IServerResponse -> IO ()
-- filterExample :: String -> [String] -> [String]
-- filterExample a b = filter (\n -> n /= a) b
leftCommand :: IServerResponse -> IO String
leftCommand serverResponse = do
let currentChannelName = (channelName serverResponse)
output <- L.readFile ".connection.json"
let option = fromJust (A.decode output :: Maybe IOptions)
let myServers = (servers option)
result <- mapM (\x -> if (serverName serverResponse) == (server x) then return $ x { channels = (filter (\n -> n /= currentChannelName) (channels x)) } else return x ) (myServers)
writeConfigFile option result
return $ "just returning string io"
autoconnect :: IServerResponse -> IO String
autoconnect serverResponse = do
if | hasStringExist " KICK #" (readDataByteString serverResponse) -> joinChannel (sock serverResponse) (channelName serverResponse) >> {-- auto connect in case of kick --} sendMessage (sock serverResponse) (channelName serverResponse) "automated rejoin, if you want me to leave use .leave"
| otherwise -> print "NO CONDITION FOUND TO PARSE"
return $ prepareJoinChannel (channelName serverResponse)
randomImage :: IServerResponse -> IO ()
randomImage :: IServerResponse -> IO String
randomImage serverResponse = do
if | hasStringExist ".random" (readDataByteString serverResponse) -> basicRandomImplementation (readDataString serverResponse) >>= \commandOutput -> sendMessage (sock serverResponse) (channelName serverResponse) commandOutput
| otherwise -> print "NO CONDITION FOUND TO PARSE"
x <- basicRandomImplementation (messageText serverResponse)
return $ prepareSendMessage (channelName serverResponse) x
botsCommand :: IServerResponse -> IO String
botsCommand serverResponse = do
does <- doesFileExist ".bots.txt"
if does then do
handle <- openFile ".bots.txt" ReadMode
content <- hGetContents handle
if length content > 0 then
return $ prepareSendMessage (channelName serverResponse) content
else return $ prepareSendMessage (channelName serverResponse) "bots.txt is empty"
else return $ prepareSendMessage (channelName serverResponse) "bots.txt doesnt exist"
quit :: IServerResponse -> IO ()
quit serverResponse = do
if | hasStringExist ".quit" (readDataByteString serverResponse) -> quitFromServer (sock serverResponse) (channelName serverResponse)
| otherwise -> print "NO CONDITION FOUND TO PARSE"
quitCommand :: IServerResponse -> IO String
quitCommand serverResponse = do
return $ prepareQuit
leave :: IServerResponse -> IO ()
leave serverResponse = do
if | hasStringExist ".leave" (readDataByteString serverResponse) -> disconnectFromChannel (sock serverResponse) (channelName serverResponse)
| otherwise -> print "NO CONDITION FOUND TO PARSE"
leaveCommand :: IServerResponse -> IO String
leaveCommand serverResponse = do
return $ prepareDisconnectFromChannel (channelName serverResponse)
data CommandTypes = SERVER | USER | NON_RETURN_ACTION deriving(Eq)
myMethodList = MethodList {methods = [basicEcho, ping, autoconnect, randomImage, quit, leave] }
data MethodDefinition = MethodDefinition { callerString :: String, callableFunction :: IServerResponse -> IO String, commandType :: CommandTypes }
basicEchoDefinition = MethodDefinition { callerString = ".echo", callableFunction = basicEcho, commandType = USER }
pingDefinition = MethodDefinition { callerString = "PING", callableFunction = ping, commandType = SERVER }
bostDefinition = MethodDefinition { callerString = ".bots", callableFunction = botsCommand, commandType = USER }
quitDefinition = MethodDefinition { callerString = ".quit", callableFunction = quitCommand, commandType = USER }
leaveDefinition = MethodDefinition { callerString = ".leave", callableFunction = leaveCommand, commandType = USER }
leftDefinition = MethodDefinition { callerString = ".left", callableFunction = leftCommand, commandType = NON_RETURN_ACTION }
autoconnectDefinition = MethodDefinition { callerString = "KICK", callableFunction = autoconnect, commandType = NON_RETURN_ACTION }
myMethodList = MethodList {methods = [basicEchoDefinition,pingDefinition,bostDefinition,quitDefinition,leaveDefinition,autoconnectDefinition] }
myAdminMethodList = MethodList { methods = []}

6
src/IrcBot/BotNetwork.hs
View File

@ -7,8 +7,8 @@ import Network.Socket.ByteString (recv, sendAll)
import qualified Data.ByteString.Char8 as C
import Network.Connection
readFromSocket:: Connection -> IO C.ByteString
writeToSocket:: Connection -> String -> IO()
readFromSocket :: Connection -> IO C.ByteString
writeToSocket :: Connection -> String -> IO()
writeToSocket sock stringData =
@ -29,7 +29,7 @@ readFromSocket sock =
return C.empty
open:: String -> PortNumber -> Bool -> IO Connection
open :: String -> PortNumber -> Bool -> IO Connection
open server port ssl = do
ctx <- initConnectionContext

62
src/IrcBot/BotNetworkCommands.hs
View File

@ -6,11 +6,15 @@ import Network.Connection
import Data.List.Utils (replace)
sendMessage :: Connection -> String -> String -> IO ()
sendMessage sock targetChannel stringData =
do
let combiendStringData = "PRIVMSG " ++ targetChannel ++ " :" ++ stringData
writeToSocket sock combiendStringData
-- print "SENT STRING: "
-- print combiendStringData
writeToSocket sock (prepareSendMessage targetChannel stringData)
prepareSendMessage :: String -> String -> String
prepareSendMessage targetChannel stringData = "PRIVMSG " ++ targetChannel ++ " :" ++ stringData
@ -18,42 +22,60 @@ quitFromServer :: Connection -> String -> IO ()
quitFromServer sock targetChannel =
do
writeToSocket sock "QUIT"
writeToSocket sock prepareQuit
prepareQuit :: String
prepareQuit = "QUIT"
disconnectFromChannel :: Connection -> String -> IO ()
disconnectFromChannel sock targetChannel =
do
writeToSocket sock ("PART " ++ targetChannel)
writeToSocket sock (prepareDisconnectFromChannel targetChannel)
prepareDisconnectFromChannel :: String -> String
prepareDisconnectFromChannel targetChannel = ("PART " ++ targetChannel)
initAuthNickServ :: Connection -> String -> String -> IO()
initAuthNickServ sock userName password =
do
sendMessage sock "NickServ" (prepareInitAuthNickServ userName password)
prepareInitAuthNickServ :: String -> String -> String
prepareInitAuthNickServ userName password = "IDENTIFY " ++ userName ++ " " ++ password
initBotName :: Connection -> String -> IO ()
initBotName sock botName =
do
let dataString = "USER "++ botName ++" "++ botName ++" "++ botName ++" :learning purpose bot"
writeToSocket sock dataString
initBotName sock botName = writeToSocket sock (prepareInitBotName botName)
initBotNick :: Connection -> String -> IO ()
prepareInitBotName :: String -> String
prepareInitBotName botName = "USER "++ botName ++" "++ botName ++" "++ botName ++" :learning purpose bot"
initBotNick :: Connection -> String -> IO ()
initBotNick sock botNick =
do
let nick = "NICK " ++ botNick
writeToSocket sock nick
writeToSocket sock (preparetInitBotNick botNick)
preparetInitBotNick :: String -> String
preparetInitBotNick botNick = "NICK " ++ botNick
joinChannel :: Connection -> String -> IO ()
joinChannel sock channelName =
do
let combinedString = "JOIN " ++ channelName
writeToSocket sock combinedString
writeToSocket sock (prepareJoinChannel channelName)
prepareJoinChannel :: String -> String
prepareJoinChannel channelName = "JOIN " ++ channelName
pong :: Connection -> String -> IO ()
pong sock receivedStringData = do
let replacedText = replace "PING" "PONG" receivedStringData
writeToSocket sock replacedText
writeToSocket sock (preparePong receivedStringData)
preparePong :: String -> String
preparePong receivedStringData = replace "PING" "PONG" receivedStringData

18
src/IrcBot/Config/ConfigHelper.hs Normal file
View File

@ -0,0 +1,18 @@
module IrcBot.Config.ConfigHelper where
import qualified Data.ByteString.Lazy as L
import Data.List.Split
import Data.Maybe
import IrcBot.Definitions.Options
import IrcBot.Definitions.ServerAddress
import qualified Data.Aeson as A
import IrcBot.JsonConfigDecoder
writeConfigFile :: IOptions -> [IServerAddress] -> IO ()
writeConfigFile oldOptions result = do
let options = oldOptions { servers = result }
let encodedJson = A.encode options
L.writeFile ".connection.json" encodedJson

12
src/IrcBot/Definitions/Options.hs Normal file
View File

@ -0,0 +1,12 @@
{-# LANGUAGE DeriveGeneric #-}
module IrcBot.Definitions.Options where
import IrcBot.Definitions.ServerAddress
import GHC.Generics
data IOptions = IOptions
{
admins :: [String],
servers :: [IServerAddress]
} deriving (Show,Generic)

17
src/IrcBot/Definitions/ServerAddress.hs Normal file
View File

@ -0,0 +1,17 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveGeneric #-}
module IrcBot.Definitions.ServerAddress where
import GHC.Generics
data IServerAddress = IServerAddress
{
server :: String ,
port :: Int,
ssl :: Bool,
nickname :: String,
password :: String,
channels :: [String]
} deriving (Show,Generic)

17
src/IrcBot/Definitions/ServerResponse.hs Normal file
View File

@ -0,0 +1,17 @@
module IrcBot.Definitions.ServerResponse where
import qualified Data.ByteString.Char8 as C
import Network.Connection
data IServerResponse = IServerResponse
{
serverName :: String,
readDataString :: String,
readDataByteString :: C.ByteString,
channelName :: String,
nick :: String,
messageText :: String,
messageTarget :: String,
messageType :: String
}

28
src/IrcBot/IrcBot.hs
View File

@ -9,37 +9,25 @@ import IrcBot.BotNetwork
import Network.Connection
import qualified Control.Concurrent as T
import qualified Data.ByteString.Char8 as C
data IServerAddress = IServerAddress
{
server :: String ,
port :: Int,
ssl :: Bool,
nickname :: String,
channels :: [String]
} deriving (Show)
data IOptions = IOptions
{
servers :: [Maybe IServerAddress]
} deriving (Show)
import IrcBot.Definitions.ServerAddress
connectToIRCServer :: Maybe IServerAddress -> IO ()
connectToIRCServer (Just serverAddress) = do
connectToIRCServer :: IServerAddress -> IO ()
connectToIRCServer serverAddress = do
newSock <- connectToServer (server serverAddress) (fromIntegral (port serverAddress)) (ssl serverAddress)
print "[connected to server]"
initBotName newSock (nickname serverAddress)
initBotNick newSock (nickname serverAddress)
initAuthNickServ newSock (nickname serverAddress) (password serverAddress)
print "waiting for identification with very stupid way"
T.threadDelay (1000000 * 15) --wait wait
let channelsToJoin = channels serverAddress
mapM (\x -> joinChannel newSock x) channelsToJoin
connectionLoop newSock
connectionLoop newSock serverAddress
print "sleeping 15 sec for reconnect"
-- 1000000 is 1 second
T.threadDelay (1000000 * 15)
print "reconnecting sequence initializing"
-- this is a recursive function and its maintaining own connectivity
-- how deep can i call this function? or just compiler optimizes for me? no idea
connectToIRCServer (Just serverAddress)
connectToIRCServer (serverAddress)

14
src/IrcBot/JsonConfigDecoder.hs
View File

@ -1,11 +1,14 @@
{-# LANGUAGE OverloadedStrings #-}
module IrcBot.JsonConfigDecoder where
import Data.Aeson
import Network.Socket
import IrcBot.IrcBot
import qualified Data.ByteString.Lazy as C
import IrcBot.Definitions.Options
import IrcBot.Definitions.ServerAddress
import GHC.Generics
instance FromJSON IServerAddress where
@ -14,15 +17,18 @@ instance FromJSON IServerAddress where
port_ <- o .: "port"
ssl_ <- o .: "ssl"
nickname_ <- o .: "nickname"
password_ <- o .: "password"
channels_ <- o .: "channels"
return $ IServerAddress server_ port_ ssl_ nickname_ channels_
return $ IServerAddress server_ port_ ssl_ nickname_ password_ channels_
instance FromJSON IOptions where
parseJSON = withObject "IOptions" $ \o -> do
admins_ <- o .: "admins"
servers_ <- o .: "servers"
return $ IOptions servers_
return $ IOptions admins_ servers_
instance ToJSON IServerAddress
instance ToJSON IOptions
--readConfigFile :: Maybe IServerAddress
--readConfigFile = C.readFile ".connection.json" >>= \output -> decode output :: Maybe IServerAddress

58
src/IrcBot/MessageParser.hs
View File

@ -16,8 +16,40 @@ slice :: Int -> Int -> String -> String
slice start end = take (end-start-1) . drop (start+1)
parseMessageMeta :: String -> String
parseMessageMeta messageMeta = do
let startEndIndexes = elemIndices ':' messageMeta
if length startEndIndexes >= 2 then do
let startIndex = startEndIndexes !! 0
let endIndex = startEndIndexes !! 1
slice (startIndex) (endIndex) messageMeta
else ""
-- :YOUR_NICK!~YOUR_NICK@YOUR_IP PRIVMSG #91623_my_test_channel
parseMessageTargetFromMeta :: [String] -> String
parseMessageTargetFromMeta messageMetaArray = do
if (length messageMetaArray) >= 3
then
messageMetaArray !! 2
else
""
-- :YOUR_NICK!~YOUR_NICK@YOUR_IP PRIVMSG #91623_my_test_channel :TEXT MESSAGE
parseMessageType :: [String] -> String
parseMessageType messageMetaArray = do
if(length messageMetaArray) >= 3
then
messageMetaArray !! 1
else
""
targetDeterminer :: String -> String -> String
targetDeterminer nickName channelName = do
if (length channelName) > 1 then channelName else nickName
parseNick :: String -> String
@ -25,7 +57,11 @@ parseNick dataString =
do
let startIndex = elemIndex ':' dataString
let endIndex = elemIndex '!' dataString
slice (fromJust startIndex) (fromJust endIndex) dataString
if startIndex /= Nothing && endIndex /= Nothing
then
slice (fromJust startIndex) (fromJust endIndex) dataString
else ""
parseChannelName :: String -> String
@ -34,8 +70,10 @@ parseChannelName dataString =
let startIndex = elemIndex '#' dataString
let dropppedString = drop (fromJust startIndex) dataString
let endIndex = elemIndex ' ' dropppedString
take (fromJust endIndex) dropppedString
if startIndex /= Nothing && endIndex /= Nothing
then
take (fromJust endIndex) dropppedString
else ""
parseMessageText :: String -> String
@ -48,4 +86,14 @@ parseMessageText dataString =
basicRandomImplementation :: String -> IO String
basicRandomImplementation basicInput = getRandomFile "maidos" >>= \randomFileName -> uploadLocalFile randomFileName
basicRandomImplementation basicInput = do
let parameters = (words basicInput)
print ".random parameters: "
print parameters
if length parameters > 1 then
do
let directoryName = parameters !! 1
getRandomFile directoryName >>= \randomFileName -> uploadLocalFile randomFileName
else
getRandomFile "maidos" >>= \randomFileName -> uploadLocalFile randomFileName

23
src/IrcBot/RandomFileFinder.hs
View File

@ -2,8 +2,8 @@ module IrcBot.RandomFileFinder where
import System.Directory
import System.Random
import Data.List
import Control.Monad.IO.Class
getRandomFile :: String -> IO String
@ -11,8 +11,17 @@ getRandomFile :: String -> IO String
getRandomFile directoryName =
do
let fullDirectoryName = "./.warehouse/" ++ directoryName
directoryItems <- getDirectoryContents fullDirectoryName
result <- return (length directoryItems) >>= \count -> randomRIO(4,count) :: IO Int
let fileName = directoryItems !! result
let newFileName = ".warehouse/" ++ directoryName ++ "/" ++ fileName
return newFileName
acceptedDirectoryNames <- (listDirectory "./.warehouse") >>= \x -> return x
print acceptedDirectoryNames
let directoryExist = elem directoryName acceptedDirectoryNames
if directoryExist then do
directoryItems <- getDirectoryContents fullDirectoryName
let directoryItemCount = (length directoryItems)
print "directory item count is: "
if directoryItemCount > 2 then do -- . and .. basically makes 2
result <- randomRIO(2,(directoryItemCount-1)) :: IO Int -- 2 represents an index which is exludes 0,1 elements from file list (. and ..)
let fileName = directoryItems !! result
return $ ".warehouse/" ++ directoryName ++ "/" ++ fileName
else return $ ""
else return $ ""

11
src/IrcBot/RemoteUploader.hs
View File

@ -4,11 +4,12 @@ module IrcBot.RemoteUploader where
import System.Process
uploadLocalFile:: String -> IO String
uploadLocalFile :: String -> IO String
uploadLocalFile filePath =
do
let command = "curl"
let params = "file=@"++ filePath
readProcess command ["-F",params,"0x0.st"] ""
if filePath /= "" then do
let command = "curl"
let params = "file=@"++ filePath
readProcess command ["-F",params,"0x0.st"] ""
else return $ ";_;"