ClientTest.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Main where
  12
  13 import System.Environment
  14 import Control.Monad
  15 import Data.Maybe
  16 import System.IO
  17 import qualified Data.ByteString.Lazy as L
  18 import Data.Binary
  19 import Data.List (intersperse)
  20 import Data.Char
  21
  22 --import Data.BinaryCom as BC
  23 import Network.Fancy
  24 import Text.Show.Pretty (ppShow)
  25
  26 import Protocol
  27 import Metagame
  28 import BinaryInstances
  29 import Mundanities
  30 import Lock
  31 import Physics
  32
  33 port = 27001 -- 27001 == ('i'<<8) + 'y'
  34 main = withStream (IP "localhost" port) handler
  35
  36 readAL :: String -> ActiveLock
  37 readAL s = ActiveLock (take 3 s) ((ord $ s!!4) - ord 'A')
  38
  39 handler :: Handle -> IO ()
  40 handler handle = do
  41     (name:passwd:cmd:args) <- getArgs
  42     action <- case cmd of
  43         "auth" -> return Authenticate
  44         "reg" -> return Register
  45         "sinfo" -> return GetServerInfo
  46         "getlock" -> return $ GetLock (read $ head args)
  47         "getuinfo" -> return $ GetUserInfo (head args)
  48         "getsolution" -> return $ GetSolution (read $ head args)
  49         "gethint" -> return $ GetHint (read $ head args)
  50         "setlock" -> liftM3 SetLock (fromJust `liftM` readReadFile (args!!0)) (return $ read (args!!1)) (fromJust `liftM` readReadFile (args!!2))
  51         "declare" -> liftM4 DeclareSolution (fromJust `liftM` readReadFile (args!!0)) (return $ read (args!!1)) (return $ readAL (args!!2)) (return $ read (args!!3))
  52     let request = ClientRequest protocolVersion (Just (Auth name passwd)) action
  53     L.hPut handle $ encode request
  54     hFlush handle
  55     response <- decode `liftM` L.hGetContents handle
  56     putStrLn $ ppShow (response :: ServerResponse)
  57