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           Control.Monad
  14 import           Data.Binary
  15 import qualified Data.ByteString.Lazy as L
  16 import           Data.Char
  17 import           Data.List            (intersperse)
  18 import           Data.Maybe
  19 import           System.Environment
  20 import           System.IO
  21
  22 --import Data.BinaryCom as BC
  23 import           Network.Fancy
  24 import           Text.Show.Pretty     (ppShow)
  25
  26 import           BinaryInstances
  27 import           Lock
  28 import           Metagame
  29 import           Mundanities
  30 import           Physics
  31 import           Protocol
  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 <$> readReadFile (head args)) (return $ read (args!!1)) (fromJust <$> readReadFile (args!!2))
  51         "declare" -> liftM4 DeclareSolution (fromJust <$> readReadFile (head args)) (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 <$> L.hGetContents handle
  56     putStrLn $ ppShow (response :: ServerResponse)
  57