Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 633 lines (522 sloc) 21.459 kb
b25bd7e3 »
2011-01-27 move all proxy state into one value
1 {-# LANGUAGE RecordWildCards #-}
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
2 {-# LANGUAGE PatternGuards #-}
369d1fab »
2011-01-23 Split out the proxy code from protocol code
3 module Main where
4
33d1b874 »
2011-01-24 Checkpoint
5 import Control.Applicative
369d1fab »
2011-01-23 Split out the proxy code from protocol code
6 import Control.Concurrent
7 import Control.Exception
8 import Control.Monad
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
9 import Data.Array.IO
369d1fab »
2011-01-23 Split out the proxy code from protocol code
10 import Data.Binary.Put (runPut)
f7b3fbba »
2011-01-23 Add more protocol field documentation and refine protocol types
11 import Data.Bits
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
12 import Data.ByteString.Lazy (ByteString)
369d1fab »
2011-01-23 Split out the proxy code from protocol code
13 import Data.Foldable
14 import Data.IORef
15 import Data.Int
fbc04209 »
2011-01-31 Add a nearby players list function
16 import Data.List (isPrefixOf, intercalate)
369d1fab »
2011-01-23 Split out the proxy code from protocol code
17 import Data.Map (Map)
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
18 import Data.Maybe (fromMaybe,mapMaybe)
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
19 import Data.Set (Set)
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
20 import Data.Traversable (for)
21 import Data.Word
369d1fab »
2011-01-23 Split out the proxy code from protocol code
22 import Network.Socket hiding (send)
23 import Network.Socket.ByteString.Lazy
d8bc0d7d »
2011-01-31 Refactor the proxy function
24 import Prelude hiding (getContents, catch)
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
25 import System.Console.GetOpt
369d1fab »
2011-01-23 Split out the proxy code from protocol code
26 import System.Environment
27 import System.Exit
f2e2206b »
2011-01-30 Update networking code and add more comments
28 import System.IO hiding (getContents)
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
29 import qualified Data.ByteString.Lazy as L
369d1fab »
2011-01-23 Split out the proxy code from protocol code
30 import qualified Data.Map as Map
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
31 import qualified Data.Set as Set
fb7a64f0 »
2011-01-23 Split out entity tracking
32 import qualified Network
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
33
33d1b874 »
2011-01-24 Checkpoint
34 import GameState
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
35 import JavaBinary
36 import Protocol
369d1fab »
2011-01-23 Split out the proxy code from protocol code
37
b25bd7e3 »
2011-01-27 move all proxy state into one value
38 data ProxyState = PS
39 { gameState :: MVar GameState
40 , glassVar :: IORef Bool
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
41 , digThrough :: IORef Int
9a10ea4d »
2011-01-30 Add a \time command
42 , timeVar :: IORef (Maybe Int64)
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
43 , restoreVar :: MVar (Map (Int32,Int32) (Set (Int8, Int8, Int8)))
b25bd7e3 »
2011-01-27 move all proxy state into one value
44 , lineVar :: IORef (Bool, [Message])
45 , digVar :: IORef Int
dc340989 »
2011-01-29 Add \help and \status
46 , followVar :: MVar (Maybe (String, EntityId))
234542a2 »
2011-01-31 Make console more configurable
47 , consoleFile :: Maybe String
b25bd7e3 »
2011-01-27 move all proxy state into one value
48 }
49
234542a2 »
2011-01-31 Make console more configurable
50 newProxyState :: Maybe String -> IO ProxyState
51 newProxyState consoleFile = do
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
52 gameState <- newMVar newGameState
53 glassVar <- newIORef False
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
54 digThrough <- newIORef 0
9a10ea4d »
2011-01-30 Add a \time command
55 timeVar <- newIORef Nothing
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
56 restoreVar <- newMVar Map.empty
57 lineVar <- newIORef (False, [])
58 digVar <- newIORef 1
59 followVar <- newMVar Nothing
b25bd7e3 »
2011-01-27 move all proxy state into one value
60 return PS {..}
61
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
62 data Configuration = Config
f2e2206b »
2011-01-30 Update networking code and add more comments
63 { listenHost :: Maybe HostName
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
64 , listenPort :: ServiceName
234542a2 »
2011-01-31 Make console more configurable
65 , configConsoleFile :: Maybe String
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
66 , configHelp :: Bool }
67
68 defaultConfig = Config
f2e2206b »
2011-01-30 Update networking code and add more comments
69 { listenHost = Nothing
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
70 , listenPort = "25565"
71 , configHelp = False
234542a2 »
2011-01-31 Make console more configurable
72 , configConsoleFile = Nothing
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
73 }
74
75
76
369d1fab »
2011-01-23 Split out the proxy code from protocol code
77 main :: IO ()
521b7f52 »
2011-01-30 Add the withSocketsDo command to main
78 main = withSocketsDo $ do
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
79 (host,port,config) <- getOptions
80
f2e2206b »
2011-01-30 Update networking code and add more comments
81 let passiveHints = defaultHints { addrSocketType = Stream
82 , addrFlags = [AI_ADDRCONFIG,AI_PASSIVE] }
83 proxyAIs <- getAddrInfo (Just passiveHints)
84 (listenHost config)
85 (Just (listenPort config))
86
87 let activeHints = defaultHints { addrSocketType = Stream
88 , addrFlags = [AI_ADDRCONFIG] }
89 serverAI <- head <$> getAddrInfo (Just activeHints) (Just host) (Just port)
90
234542a2 »
2011-01-31 Make console more configurable
91 waitThreadGroup $ map (makeListenerThread (configConsoleFile config) serverAI) proxyAIs
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
92
f2e2206b »
2011-01-30 Update networking code and add more comments
93
94 -- | 'makeListenerThread' binds to the specified address on the proxy
95 -- and makes connections to the specified server address.
96 makeListenerThread ::
234542a2 »
2011-01-31 Make console more configurable
97 Maybe FilePath {- ^ console file path -} ->
f2e2206b »
2011-01-30 Update networking code and add more comments
98 AddrInfo {- ^ Server's address information -} ->
99 AddrInfo {- ^ Proxy's address information -} ->
100 IO ()
234542a2 »
2011-01-31 Make console more configurable
101 makeListenerThread consoleFile serverAI proxyAI = do
f2e2206b »
2011-01-30 Update networking code and add more comments
102 l <- addrInfoToSocket proxyAI
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
103 setSocketOption l ReuseAddr 1
f2e2206b »
2011-01-30 Update networking code and add more comments
104 bindSocketToAddrInfo l proxyAI
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
105 listen l 5
106
de42c344 »
2011-01-31 Add echo-console
107 putStr $ "Ready to accept connections on " ++ show (addrAddress proxyAI) ++ "\n"
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
108
f2e2206b »
2011-01-30 Update networking code and add more comments
109 forever $ do (clientSock, clientAddr) <- accept l
234542a2 »
2011-01-31 Make console more configurable
110 _ <- forkIO (handleClient consoleFile serverAI clientSock clientAddr)
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
111 return ()
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
112
f2e2206b »
2011-01-30 Update networking code and add more comments
113 handleClient ::
234542a2 »
2011-01-31 Make console more configurable
114 Maybe FilePath {- ^ console file path -} ->
f2e2206b »
2011-01-30 Update networking code and add more comments
115 AddrInfo {- ^ Server's information -} ->
116 Socket {- ^ Client's socket -} ->
117 SockAddr {- ^ Client's address -} ->
118 IO ()
234542a2 »
2011-01-31 Make console more configurable
119 handleClient consoleFile serverAI c csa = do
369d1fab »
2011-01-23 Split out the proxy code from protocol code
120 putStr "Got connection from "
121 print csa
122
f2e2206b »
2011-01-30 Update networking code and add more comments
123 s <- addrInfoToSocket serverAI
124 connectToAddrInfo s serverAI
234542a2 »
2011-01-31 Make console more configurable
125 proxy consoleFile c s
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
126
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
127 `Control.Exception.catch` \ (SomeException e) -> do
b25bd7e3 »
2011-01-27 move all proxy state into one value
128 sendAll c $ encode $ Disconnect (show e)
129 fail (show e)
369d1fab »
2011-01-23 Split out the proxy code from protocol code
130
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
131 -- | 'proxy' creates the threads necessary to proxy a Minecraft
132 -- connection between a client and a server socket.
133 proxy ::
234542a2 »
2011-01-31 Make console more configurable
134 Maybe FilePath {- ^ console file path -} ->
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
135 Socket {- ^ client socket -} ->
136 Socket {- ^ server socket -} ->
137 IO ()
234542a2 »
2011-01-31 Make console more configurable
138 proxy consoleFile c s = do
e5d78b87 »
2011-01-29 Add commandline flags to change proxy's listen host/port
139
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
140 var <- newChan
234542a2 »
2011-01-31 Make console more configurable
141 state <- newProxyState consoleFile
b25bd7e3 »
2011-01-27 move all proxy state into one value
142 clientChan <- newChan
143 serverChan <- newChan
d8bc0d7d »
2011-01-31 Refactor the proxy function
144
145
146 let bad who (SomeException e) = print e >> writeChan var who
147 start who f xsm = forkIO . handle (bad who) . traverse_ f =<< xsm
148
149
150 serverToProxy <- start "inbound" (inboundLogic clientChan state) (getMessages s)
151 clientToProxy <- start "outbound" (outboundLogic clientChan serverChan state) (getMessages c)
152
153 proxyToClient <- start "inbound network" (sendAll c) (getChanContents clientChan)
154 proxyToServer <- start "outbound network" (sendAll s) (getChanContents serverChan)
155
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
156 who <- readChan var
369d1fab »
2011-01-23 Split out the proxy code from protocol code
157 putStr who
158 putStrLn " died"
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
159 traverse_ killThread [serverToProxy, proxyToClient, proxyToServer, clientToProxy]
d8bc0d7d »
2011-01-31 Refactor the proxy function
160
161 getMessages :: Socket -> IO [Message]
162 getMessages s = toMessages <$> getContents s
163
369d1fab »
2011-01-23 Split out the proxy code from protocol code
164
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
165 makeGlass :: BlockId -> BlockId
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
166 makeGlass Dirt = Glass
b25bd7e3 »
2011-01-27 move all proxy state into one value
167 makeGlass Stone = Glass
168 makeGlass Grass = Glass
20a891f3 »
2011-01-30 Turn snow to glass as well
169 makeGlass Snow = Glass
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
170 makeGlass other = other
b25bd7e3 »
2011-01-27 move all proxy state into one value
171
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
172 inboundLogic ::
173 Chan ByteString {- ^ client channel -} ->
174 ProxyState ->
175 Message ->
176 IO ()
177 inboundLogic clientChan state msg = do
fb7a64f0 »
2011-01-23 Split out entity tracking
178
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
179 -- Track entities
b25bd7e3 »
2011-01-27 move all proxy state into one value
180 changedEid <- modifyMVar (gameState state) $ \ gs -> do
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
181 (change, gs') <- updateGameState msg gs
182 gs' `seq` return (gs', change)
fb7a64f0 »
2011-01-23 Split out entity tracking
183
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
184 -- Global glass modifications
b25bd7e3 »
2011-01-27 move all proxy state into one value
185 glass <- readIORef (glassVar state)
9a10ea4d »
2011-01-30 Add a \time command
186 time <- readIORef (timeVar state)
f7b3fbba »
2011-01-23 Add more protocol field documentation and refine protocol types
187 let msg' = case msg of
e05639d3 »
2011-01-25 Glass attack checkpoint
188 Mapchunk x y z sx sy sz bs a b c
189 | glass -> Mapchunk x y z sx sy sz (map makeGlass bs) a b c
9a10ea4d »
2011-01-30 Add a \time command
190 TimeUpdate t -> case time of
191 Nothing -> msg
192 Just t' -> TimeUpdate t'
f7b3fbba »
2011-01-23 Add more protocol field documentation and refine protocol types
193 _ -> msg
194
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
195 -- Update compass
196 followMsgs <- withMVar (followVar state) $ \ interested ->
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
197 case interested of
dc340989 »
2011-01-29 Add \help and \status
198 Just (_,ieid) | fmap snd interested == changedEid -> do
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
199 e <- entityMap <$> readMVar (gameState state)
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
200 return $ case Map.lookup ieid e of
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
201 Just (_ty, x, y, z) ->
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
202 [SpawnPosition (x `div` 32) (y `div` 32) (z `div` 32)]
203 _ -> []
204 _ -> return []
205
206 sendMessages clientChan (msg' : followMsgs)
33d1b874 »
2011-01-24 Checkpoint
207
208
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
209 processCommand ::
210 Chan ByteString {- ^ client channel -} ->
211 ProxyState ->
212 String {- ^ chat command -} ->
213 IO ()
33d1b874 »
2011-01-24 Checkpoint
214
234542a2 »
2011-01-31 Make console more configurable
215 processCommand clientChan state "console-echo"
216 = case consoleFile state of
217 Nothing -> tellPlayer clientChan "Console not enabled"
218 Just fp -> makePipeListener clientChan fp
de42c344 »
2011-01-31 Add echo-console
219
dc340989 »
2011-01-29 Add \help and \status
220 processCommand clientChan _ "help"
221 = traverse_ (tellPlayer clientChan) helpMessage
222
fbc04209 »
2011-01-31 Add a nearby players list function
223 processCommand clientChan state "list"
224 = do players <- listPlayers state
225 tellPlayer clientChan $ "Players: " ++ intercalate ", " players
226
dc340989 »
2011-01-29 Add \help and \status
227 processCommand clientChan state "status"
228 = traverse_ (tellPlayer clientChan) =<< statusMessages state
5b04420f »
2011-01-28 Update Harp ID to be 0
229
9a10ea4d »
2011-01-30 Add a \time command
230 processCommand clientChan state "time off"
231 = writeIORef (timeVar state) Nothing
232 *> tellPlayer clientChan "Time passing"
233
234 processCommand clientChan state text
235 | "time " `isPrefixOf` text
236 = case reads (drop 5 text) of
237 [(n,_)] | 0 <= n && n <= 24000 -> writeIORef (timeVar state) (Just n)
238 *> tellPlayer clientChan "Time fixed"
239 _ -> tellPlayer clientChan "Unable to parse time"
240
5b04420f »
2011-01-28 Update Harp ID to be 0
241 processCommand clientChan state text
242 | "echo " `isPrefixOf` text
243 = case reads (drop 5 text) of
244 [(msg,_)] -> sendMessages clientChan [msg]
245 _ -> tellPlayer clientChan "Unable to parse message"
246
b25bd7e3 »
2011-01-27 move all proxy state into one value
247 processCommand clientChan state "glass on"
248 = writeIORef (glassVar state) True
249 *> tellPlayer clientChan "Glass On"
24010c60 »
2011-01-26 Add dig speed command
250
b25bd7e3 »
2011-01-27 move all proxy state into one value
251 processCommand clientChan state "glass off"
252 = writeIORef (glassVar state) False
253 *> tellPlayer clientChan "Glass Off"
24010c60 »
2011-01-26 Add dig speed command
254
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
255 processCommand clientChan state text | "through " `isPrefixOf` text
256 = case reads $ drop 8 text of
257 [(n,_)] -> writeIORef (digThrough state) n
258 *> tellPlayer clientChan "Through Set"
259 _ -> tellPlayer clientChan "Bad through value"
260
b25bd7e3 »
2011-01-27 move all proxy state into one value
261 processCommand clientChan state text | "dig " `isPrefixOf` text
262 = case reads $ drop 4 text of
263 [(n,_)] -> writeIORef (digVar state) n
264 *> tellPlayer clientChan "Dig Set"
265
266 _ -> tellPlayer clientChan "Bad dig number"
267
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
268 processCommand clientChan state "follow off" = do
269 modifyMVar_ (followVar state) $ \ _ -> do
270 mb <- spawnLocation <$> readMVar (gameState state)
271 case mb of
272 Nothing -> tellPlayer clientChan "Follow disabled - spawn point unknown"
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
273 Just (x,y,z) -> do sendMessages clientChan [SpawnPosition x y z]
96fd2162 »
2011-01-28 Revert compass to spawn point when possible
274 tellPlayer clientChan "Follow disabled - compass restored"
275 return Nothing
276
b25bd7e3 »
2011-01-27 move all proxy state into one value
277 processCommand clientChan state text | "follow " `isPrefixOf` text
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
278 = do e <- entityMap <$> readMVar (gameState state)
279 case find (\ (_,(x,_,_,_)) -> x == Left key) (Map.assocs e) of
dc340989 »
2011-01-29 Add \help and \status
280 Just (k,_) -> swapMVar (followVar state) (Just (key,k))
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
281 *> tellPlayer clientChan "Follow registered"
282 Nothing -> tellPlayer clientChan "Player not found"
33d1b874 »
2011-01-24 Checkpoint
283 where key = drop 7 text
284
b25bd7e3 »
2011-01-27 move all proxy state into one value
285 processCommand clientChan state "lines on"
286 = writeIORef (lineVar state) (True, [])
287 *> tellPlayer clientChan "Lines On"
0c225ca6 »
2011-01-26 Move to mutable arrays and include a line drawing command
288
b25bd7e3 »
2011-01-27 move all proxy state into one value
289 processCommand clientChan state "lines off"
290 = modifyIORef (lineVar state) (\ (_ , xs) -> (False, xs))
291 *> tellPlayer clientChan "Lines Off"
0c225ca6 »
2011-01-26 Move to mutable arrays and include a line drawing command
292
b25bd7e3 »
2011-01-27 move all proxy state into one value
293 processCommand clientChan _ _
294 = tellPlayer clientChan "Command not understood"
33d1b874 »
2011-01-24 Checkpoint
295
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
296
297 sendMessages :: Chan L.ByteString -> [Message] -> IO ()
298 sendMessages _ [] = return ()
299 sendMessages chan xs = writeChan chan . runPut . traverse_ putJ $ xs
300
301 tellPlayer :: Chan L.ByteString -> String -> IO ()
302 tellPlayer chan text = sendMessages chan [proxyChat text]
369d1fab »
2011-01-23 Split out the proxy code from protocol code
303
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
304 outboundLogic :: Chan ByteString {- ^ client channel -} ->
305 Chan ByteString {- ^ server channel -} ->
306 ProxyState ->
307 Message ->
308 IO ()
309 outboundLogic clientChan serverChan state msg = do
0c225ca6 »
2011-01-26 Move to mutable arrays and include a line drawing command
310
b25bd7e3 »
2011-01-27 move all proxy state into one value
311 (recording, macros) <- readIORef $ lineVar state
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
312 shiftCount <- readIORef (digThrough state)
0c225ca6 »
2011-01-26 Move to mutable arrays and include a line drawing command
313
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
314 msgs <- case msg of
369d1fab »
2011-01-23 Split out the proxy code from protocol code
315 PlayerPosition {} -> return [msg]
316 PlayerPositionLook {} -> return [msg]
317 PlayerLook {} -> return [msg]
318 Player {} -> return [msg]
319 KeepAliv -> return [msg]
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
320
24010c60 »
2011-01-26 Add dig speed command
321 PlayerDigging Digging x y z face -> do
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
322 let (x',y',z') = digShift x y z face shiftCount
b25bd7e3 »
2011-01-27 move all proxy state into one value
323 n <- readIORef $ digVar state
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
324 return $ replicate n $ PlayerDigging Digging x' y' z' face
325
326 PlayerDigging action x y z face -> do
327 let (x',y',z') = digShift x y z face shiftCount
328 return [PlayerDigging action x' y' z' face]
329
e05639d3 »
2011-01-25 Glass attack checkpoint
330 PlayerBlockPlacement x y z _ (Just (IID 0x15B, _, _)) -> do
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
331 attacked <- glassAttack clientChan state x y z
332 return $ if attacked then [] else [msg]
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
333
f08cc7f9 »
2011-01-29 Move glass undoing to compass action
334 PlayerBlockPlacement x y z None (Just (IID 0x159, _, _)) -> do
335 restoreMap <- swapMVar (restoreVar state) Map.empty
336 bm <- blockMap <$> readMVar (gameState state)
337 msgs <- makeRestore bm restoreMap
338 if null msgs
339 then tellPlayer clientChan "Nothing to restore"
340 else tellPlayer clientChan "Restoring!"
341 *> sendMessages clientChan msgs
342 return []
343
344
0c225ca6 »
2011-01-26 Move to mutable arrays and include a line drawing command
345 PlayerBlockPlacement x1 y1 z1 f o | recording -> case macros of
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
346 [PlayerBlockPlacement x y z _ _] ->
347 do writeIORef (lineVar state) (recording, [msg])
348 return $ drawLine msg x y z x1 y1 z1 f o
349
350 _ -> [msg] <$ writeIORef (lineVar state) (recording, [msg])
351
352 Chat ('\\':xs) -> [] <$ processCommand clientChan state xs
369d1fab »
2011-01-23 Split out the proxy code from protocol code
353
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
354 _ -> [msg] <$ putStrLn ("outbound: " ++ show msg)
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
355 sendMessages serverChan msgs
356
357 glassAttack ::
358 Chan ByteString {- ^ client channel -} ->
359 ProxyState ->
360 Int32 {- ^ X block coordinate -} ->
361 Int8 {- ^ Y block coordinate -} ->
362 Int32 {- ^ Z block coordinate -} ->
363 IO Bool
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
364 glassAttack clientChan state x y z = do
365 bm <- blockMap <$> readMVar (gameState state)
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
366 let (chunkC,blockC) = decomposeCoords x y z
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
367 case Map.lookup chunkC bm of
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
368 Just (arr,_) -> do
369 blockId <- readArray arr blockC
370 if (blockId /= Air) then do
371 tellPlayer clientChan "Glass attack!"
372
62d7d393 »
2011-01-28 Add documentation
373 let coords = chunkedCoords $ nearby x y z
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
374 coords' <- mapM (filterGlassUpdate bm blockId) coords
375 let glassMsgs = makeGlassUpdate =<< coords'
376 sendMessages clientChan glassMsgs
377
378 modifyMVar_ (restoreVar state) $ \ m ->
379 return $! mergeCoords m coords'
380
381 return True
382 else return False
383 _ -> return False
384
385 mergeCoords :: Map ChunkLoc (Set BlockLoc) ->
386 [(ChunkLoc, [BlockLoc])] ->
387 Map ChunkLoc (Set BlockLoc)
388 mergeCoords = foldl' $ \ m (chunk,blocks) ->
389 let aux = Just
390 . Set.union (Set.fromList blocks)
391 . fromMaybe Set.empty
392 in if null blocks then m else Map.alter aux chunk m
393
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
394 drawLine :: Message ->
395 Int32 {- ^ First X -} ->
62d7d393 »
2011-01-28 Add documentation
396 Int8 {- ^ First Y -} ->
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
397 Int32 {- ^ First Z -} ->
398 Int32 {- ^ Second X -} ->
62d7d393 »
2011-01-28 Add documentation
399 Int8 {- ^ Second Y -} ->
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
400 Int32 {- ^ Second Z -} ->
401 Face ->
402 Maybe (ItemId, Int8, Int16) {- ^ Hand contents -} ->
403 [Message]
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
404 drawLine msg x y z x1 y1 z1 f o
405 | x == x1 && y == y1 = [PlayerBlockPlacement x y z2 f o | z2 <- [min z z1 .. max z z1]]
406 | x == x1 && z == z1 = [PlayerBlockPlacement x y2 z f o | y2 <- [min y y1 .. max y y1]]
407 | z == z1 && y == y1 = [PlayerBlockPlacement x2 y z f o | x2 <- [min x x1 .. max x x1]]
408 | otherwise = [msg]
369d1fab »
2011-01-23 Split out the proxy code from protocol code
409
62d7d393 »
2011-01-28 Add documentation
410 lookupBlock :: BlockMap -> ChunkLoc -> BlockLoc -> IO (Maybe BlockId)
0c225ca6 »
2011-01-26 Move to mutable arrays and include a line drawing command
411 lookupBlock bm chunkC blockC = do
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
412 for (Map.lookup chunkC bm) $ \ (blockArray, _) ->
413 readArray blockArray blockC
e05639d3 »
2011-01-25 Glass attack checkpoint
414
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
415 filterGlassUpdate :: BlockMap -> BlockId -> (ChunkLoc, [BlockLoc]) -> IO (ChunkLoc, [BlockLoc])
4171c8cf »
2011-01-29 Move multiblock coordinate parsing into Protocol
416 filterGlassUpdate bm victim (chunk, blocks) = do
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
417 let isVictim x = x == Just victim
4171c8cf »
2011-01-29 Move multiblock coordinate parsing into Protocol
418 xs <- filterM (\ c -> isVictim <$> lookupBlock bm chunk c) blocks
419 return (chunk,xs)
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
420
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
421 makeGlassUpdate :: (ChunkLoc,[BlockLoc]) -> [Message]
422 makeGlassUpdate (_, []) = []
4171c8cf »
2011-01-29 Move multiblock coordinate parsing into Protocol
423 makeGlassUpdate (chunk, coords)
424 = [MultiblockChange chunk [(c, Glass, 0) | c <- coords]]
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
425
426 makeRestore :: BlockMap -> Map ChunkLoc (Set BlockLoc) -> IO [Message]
427 makeRestore bm = sequence . mapMaybe toMessage . Map.toList
428 where
429 toMessage :: (ChunkLoc, Set BlockLoc) -> Maybe (IO Message)
4171c8cf »
2011-01-29 Move multiblock coordinate parsing into Protocol
430 toMessage (chunk, blocks)
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
431 = do guard (not (Set.null blocks))
432 (blockArray, metaArray) <- Map.lookup chunk bm
4171c8cf »
2011-01-29 Move multiblock coordinate parsing into Protocol
433 return $ fmap (MultiblockChange chunk)
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
434 $ for (Set.toList blocks) $ \ b ->
435 do blockType <- readArray blockArray b
436 blockMeta <- readArray metaArray b
4171c8cf »
2011-01-29 Move multiblock coordinate parsing into Protocol
437 return (b, blockType, fromIntegral blockMeta)
01454c2e »
2011-01-28 First draft of command to undo 'glass attack'
438
439
24010c60 »
2011-01-26 Add dig speed command
440
e05639d3 »
2011-01-25 Glass attack checkpoint
441
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
442 chunkedCoords :: [(Int32,Int8,Int32)] -> [(ChunkLoc, [BlockLoc])]
443 chunkedCoords = collect . map categorize
444 where categorize (x,y,z) = decomposeCoords x y z
445
446 collect :: Ord a => [(a,b)] -> [(a, [b])]
447 collect = Map.toList . Map.fromListWith (++) . map (\ (a,b) -> (a,[b]))
e05639d3 »
2011-01-25 Glass attack checkpoint
448
62d7d393 »
2011-01-28 Add documentation
449 -- | 'nearby' computes the coordinates of blocks that are within 10
450 -- blocks of the given coordinate.
451 nearby ::
452 Int32 {- ^ X coordinate -} ->
453 Int8 {- ^ Y coordinate -} ->
454 Int32 {- ^ Z coordinate -} ->
455 [(Int32,Int8,Int32)]
456 nearby x y z = filter inSphere box
20fa545c »
2011-01-28 Add a bunch of comments, types, error handlers
457 where radius :: Num a => a
458 radius = 10
f2e2206b »
2011-01-30 Update networking code and add more comments
459 inSphere (x1,y1,z1)
460 = squared radius > ( squared (x1-x)
461 + fromIntegral (squared (y1-y))
462 + squared (z1-z))
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
463 squared i = i * i
f2e2206b »
2011-01-30 Update networking code and add more comments
464 box = (,,) <$> [x-radius .. x+radius]
465 <*> [y-radius .. y+radius]
466 <*> [z-radius .. z+radius]
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
467
fbc04209 »
2011-01-31 Add a nearby players list function
468 listPlayers :: ProxyState -> IO [String]
469 listPlayers state = do
470 e <- entityMap <$> readMVar (gameState state)
471 return [ name | (Left name,_,_,_) <- Map.elems e]
472
f2e2206b »
2011-01-30 Update networking code and add more comments
473 -- | 'digShift' alters a set of coordinates given a depth and face.
474 digShift ::
475 Int32 {- ^ X coordinate -} ->
476 Int8 {- ^ Y coordinate -} ->
477 Int32 {- ^ Z coordinate -} ->
478 Face ->
479 Int {- ^ depth -} ->
480 (Int32, Int8, Int32)
e6e4d7ed »
2011-01-28 Clean up warnings, add \through command
481 digShift x y z face i = case face of
482 X1 -> (x+i',y,z)
483 X2 -> (x-i',y,z)
484 Y1 -> (x,y+i',z)
485 Y2 -> (x,y-i',z)
486 Z1 -> (x,y,z+i')
487 Z2 -> (x,y,z-i')
488 None -> (x,y,z)
489
490 where i' :: Num a => a
491 i' = fromIntegral i
dc340989 »
2011-01-29 Add \help and \status
492
f2e2206b »
2011-01-30 Update networking code and add more comments
493 -- | 'helpMessage' is sent to the client in response to "\help"
dc340989 »
2011-01-29 Add \help and \status
494 helpMessage :: [String]
495 helpMessage =
496 ["Commands:"
497 ,"\\status - List proxy status"
498 ,"\\follow <player name> - Compass points to player"
499 ,"\\follow off - Compass points to spawnpoint"
500 ,"\\dig <n> - Multiplies dig speed by 'n'"
501 ,"\\glass {on,off} - Glassify new chunks"
502 ,"\\through <n> - Dig 'n' blocks behind"
503 ,"\\lines {on,off} - Place blocks in lines on an axis"
9a10ea4d »
2011-01-30 Add a \time command
504 ,"\\time <n> - Set time to value 0--24000"
505 ,"\\time off - Allow time to pass"
fbc04209 »
2011-01-31 Add a nearby players list function
506 ,"\\list - List nearby players"
dc340989 »
2011-01-29 Add \help and \status
507 ,"Right-click with clock - Glassify local sphere"
508 ,"Right-click with compass - Revert glass spheres"
509 ]
510
f2e2206b »
2011-01-30 Update networking code and add more comments
511 -- | 'statusMessage' computes a list of messages to send to the client
512 -- based on the current proxy state.
dc340989 »
2011-01-29 Add \help and \status
513 statusMessages :: ProxyState -> IO [String]
514 statusMessages state = sequence
515 [ return "Proxy Status ------------------------"
516 , followStatus <$> readMVar (followVar state)
517 , digStatus <$> readIORef (digVar state)
518 , glassStatus <$> readIORef (glassVar state)
519 , throughStatus <$> readIORef (digThrough state)
520 , lineStatus <$> readIORef (lineVar state)
9a10ea4d »
2011-01-30 Add a \time command
521 , timeStatus <$> readIORef (timeVar state)
dc340989 »
2011-01-29 Add \help and \status
522 , restoreStatus <$> readMVar (restoreVar state)
523 ]
524 where
f2e2206b »
2011-01-30 Update networking code and add more comments
525 onOff True = highlight "on"
dc340989 »
2011-01-29 Add \help and \status
526 onOff False = highlight "off"
f2e2206b »
2011-01-30 Update networking code and add more comments
527
528 followStatus Nothing = "Following spawn point"
529 followStatus (Just (name,_)) = "Following player: " ++ highlight name
530
dc340989 »
2011-01-29 Add \help and \status
531 digStatus x = "Dig speed: " ++ highlight (show x)
f2e2206b »
2011-01-30 Update networking code and add more comments
532
dc340989 »
2011-01-29 Add \help and \status
533 glassStatus b = "Glass chunks: "++ onOff b
f2e2206b »
2011-01-30 Update networking code and add more comments
534
dc340989 »
2011-01-29 Add \help and \status
535 throughStatus n = "Dig through: " ++ highlight (show n)
f2e2206b »
2011-01-30 Update networking code and add more comments
536
dc340989 »
2011-01-29 Add \help and \status
537 lineStatus (b,_) = "Line mode: " ++ onOff b
f2e2206b »
2011-01-30 Update networking code and add more comments
538
9a10ea4d »
2011-01-30 Add a \time command
539 timeStatus Nothing = "Time mode normal"
540 timeStatus (Just x) = "Time fixed at: " ++ highlight (show x)
f2e2206b »
2011-01-30 Update networking code and add more comments
541
dc340989 »
2011-01-29 Add \help and \status
542 restoreStatus m = "Blocks to restore: " ++
543 highlight (show (Data.Foldable.sum (fmap Set.size (Map.elems m))))
f2e2206b »
2011-01-30 Update networking code and add more comments
544
545 -- Threading helpers
546
547 -- | 'waitThreadGroup' runs multiple computations in parallel
548 -- and kills the group if one of those computations terminates
549 waitThreadGroup ::
550 [IO ()] {- ^ Operations to run in parallel -} ->
551 IO ()
552 waitThreadGroup xs = do
553 var <- newEmptyMVar
554 threadIds <- for xs $ \ x -> forkIO $ x `Control.Exception.catch`
555 \ (SomeException e) -> print e >> putMVar var ()
556 takeMVar var
557 traverse_ killThread threadIds
558 where
559 n = length xs
560
561
562 -- Networking Helpers
563
564 addrInfoToSocket :: AddrInfo -> IO Socket
565 addrInfoToSocket AddrInfo {..} = socket addrFamily addrSocketType addrProtocol
566
567 bindSocketToAddrInfo :: Socket -> AddrInfo -> IO ()
568 bindSocketToAddrInfo sock AddrInfo {..} = bindSocket sock addrAddress
569
570 connectToAddrInfo :: Socket -> AddrInfo -> IO ()
571 connectToAddrInfo sock AddrInfo {..} = connect sock addrAddress
572
573
574 -- Command-line option processing
575
576 options :: [OptDescr (Configuration -> Configuration)]
577 options =
578 [ Option ['l'] ["listen-host"]
579 (ReqArg (\ str c -> c { listenHost = Just str }) "PROXY-HOSTNAME")
580 "Optional hostname to bind to"
581 , Option ['p'] ["listen-port"]
582 (ReqArg (\ str c -> c { listenPort = str }) "PROXY-SERVICENAME")
583 "Optional port to bind to"
584 , Option ['h'] ["help"]
585 (NoArg (\ c -> c { configHelp = True }))
586 "Print this list"
234542a2 »
2011-01-31 Make console more configurable
587 , Option ['c'] ["console"]
588 (ReqArg (\ str c -> c { configConsoleFile = Just str }) "PATH")
589 "Optional console file or named-pipe name"
f2e2206b »
2011-01-30 Update networking code and add more comments
590 ]
591
592 usageText :: String
593 usageText =
cba3bc4f »
2011-01-31 Make server-port argument optional and support default
594 "minecraft-proxy <FLAGS> SERVER-HOSTNAME [SERVER-PORT]\n\
f2e2206b »
2011-01-30 Update networking code and add more comments
595 \\n\
cba3bc4f »
2011-01-31 Make server-port argument optional and support default
596 \example: minecraft-proxy -l localhost -p 2000 example.com\n"
f2e2206b »
2011-01-30 Update networking code and add more comments
597
598 getOptions = do
599 (fs, args, errs) <- getOpt Permute options <$> getArgs
600 let config = foldl' (\ c f -> f c) defaultConfig fs
601 unless (null errs) $ do
602 traverse_ (hPutStrLn stderr) errs
603 hPutStrLn stderr $ usageInfo usageText options
604 exitFailure
605 when (configHelp config) $ do
606 hPutStrLn stderr $ usageInfo usageText options
607 exitSuccess
608 case args of
609 [host,port] -> return (host,port,config)
cba3bc4f »
2011-01-31 Make server-port argument optional and support default
610 [host] -> return (host,defaultMinecraftPort,config)
611 (_:_:_:_) ->
612 do hPutStrLn stderr "Too many arguments\n"
613 hPutStrLn stderr $ usageInfo usageText options
614 exitFailure
615 _ -> do hPutStrLn stderr "Required server-host missing\n"
f2e2206b »
2011-01-30 Update networking code and add more comments
616 hPutStrLn stderr $ usageInfo usageText options
617 exitFailure
de42c344 »
2011-01-31 Add echo-console
618
619 -- External command echo support
620
234542a2 »
2011-01-31 Make console more configurable
621 makePipeListener clientChan consoleFile =
de42c344 »
2011-01-31 Add echo-console
622 do forkIO $ do
234542a2 »
2011-01-31 Make console more configurable
623 xs <- lines <$> readFile consoleFile
de42c344 »
2011-01-31 Add echo-console
624 tellPlayer clientChan "Console opened"
625 traverse_ process xs
626 tellPlayer clientChan "Console closed"
627 `Control.Exception.catch` \ (SomeException e) ->
628 tellPlayer clientChan $ "Console failed: " ++ show e
629 return ()
630 where
631 process x = case reads x of
632 [(y,_)] -> sendMessages clientChan [y]
633 _ -> hPutStrLn stderr $ "Failed to parse: " ++ show x
Something went wrong with that request. Please try again.