gistfile1.hs

import System.IO
import Network
import Minecraft
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Trans
import Control.Monad.BinaryProtocol
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TChan
import Data.Int
import Data.List.Split
import Data.Binary
import Network.HTTP hiding (password)
import Text.Printf

-- State for the program: Session ID
data AmityState = AmityState { sessionId :: String, pktQueue :: TChan ClientToServerPacket}

protocolVersion :: Int32
protocolVersion = 6

launcherVersion :: Int
launcherVersion = 12

name :: String
name = "amity"

password :: String
password = "snaaake"

initBot :: BinaryProtocol ()
initBot = do
    -- Initialize the connection
    send (CTSHandshake name)
    flush

packetProtocol :: AmityState -> BinaryProtocol ()
packetProtocol ast = do
    -- Produce work from input
    pkt <- receive
    case pkt of
        STCLoginResponse eid str1 str2 ms dm ->
            putStrLnBP $ "Received login response with EID: " ++ show eid
        STCHandshake hs -> do
            putStrLnBP $ "Received Handshake: " ++ hs
            case hs of
                "-" -> putStrLnBP "No authentication necessary."
                "+" -> putStrLnBP "Password protected."
                otherwise -> do
                    putStrLnBP "Authenticating with minecraft.net..."
                    -- Make sure we can log in safely.
                    let url = printf "http://www.minecraft.net/game/joinserver.jsp?user=%s&sessionId=%s&serverId=%s" name (sessionId ast) hs
                    putStrLnBP $ "URL: " ++ url
                    rq <- liftIO . simpleHTTP $ getRequest url
                    verified <- liftIO $ getResponseBody rq
                    putStrLnBP $ "Verified?: " ++ verified
            enqueuePacket ast (CTSLoginRequest protocolVersion name "Password" 0 0)
            flush
        STCChatMessage msg -> putStrLnBP msg
        STCExplosion x y z r recs -> do
            enqueuePacket ast (CTSChatMessage "Damn boy, stop blowin' shit up!")
            flush
        STCKick msg -> putStrLnBP $ "Kicked with reason: " ++ msg
        otherwise -> return ()
    -- Dequeue as many packets as possible, and send them
    dequeuePackets ast
        
enqueuePacket :: AmityState -> ClientToServerPacket -> BinaryProtocol ()
enqueuePacket ast pkt = liftIO . atomically $ writeTChan (pktQueue ast) pkt

dequeuePackets :: AmityState -> BinaryProtocol ()
dequeuePackets ast = do
    pkts <- liftIO . atomically $ while (liftM not . isEmptyTChan $ pktQueue ast) (readTChan (pktQueue ast))
    forM_ pkts send
    flush
    
botProtocol :: AmityState -> BinaryProtocol ()
botProtocol ast = do
    -- Initialize the connection
    putStrLnBP "Initializing connection."
    initBot
    -- Create a thread to supply keep alives
    putStrLnBP "Starting keep alive supplier..."
    liftIO . forkIO . forever $ keepAlive ast
    -- Do work
    putStrLnBP "Starting main loop..."
    forever $ packetProtocol ast

keepAlive :: AmityState -> IO ()
keepAlive ast = liftIO $ do
    atomically $ writeTChan (pktQueue ast) CTSKeepAlive
    threadDelay (20 * 1000000)

putStrLnBP :: String -> BinaryProtocol ()
putStrLnBP = liftIO . putStrLn

while :: (Monad m) => m Bool -> m a -> m [a]
while p x = do b <- p; if b then (do v <- x; vs <- while p x; return (v:vs)) else return []

main :: IO ()
main = withSocketsDo $ do
    putStrLn "Starting Amity v0.0"
    rq <- simpleHTTP . getRequest $ printf "http://minecraft.net/game/getversion.jsp?user=%s&password=%s&version=%d" name password launcherVersion
    str <- getResponseBody rq
    putStrLn $ "WHOLE STRING: " ++  str
    sid <- liftM ((!! 3) . splitOn ":") $ getResponseBody rq
    putStrLn $ "Session ID: " ++ sid 
    -- Create Packet Queue
    pq <- newTChanIO
    let ast = AmityState{sessionId = sid, pktQueue = pq}
    -- GO GO GO!
    h <- connectTo  "209.159.158.150" (PortNumber 25565)
    runProtocol (botProtocol ast) h h
    hClose h