nomyx-server (empty) → 1.0.0
raw patch · 9 files changed
+482/−0 lines, 9 filesdep +Cabaldep +basedep +directorysetup-changed
Dependencies added: Cabal, base, directory, exceptions, filepath, hslogger, imprevu, lens, mtl, network, nomyx-api, nomyx-core, nomyx-language, nomyx-library, nomyx-server, nomyx-web, safe, stm, time
Files
- AUTHORS +5/−0
- Changelog +54/−0
- LICENSE +27/−0
- README.md +47/−0
- Setup.lhs +6/−0
- TODO +2/−0
- nomyx-server.cabal +53/−0
- src/Main.hs +279/−0
- test/Test.hs +9/−0
+ AUTHORS view
@@ -0,0 +1,5 @@+Corentin Dupont <corentin.dupontDELAVEGAgmail.com> (remove DELAVEGA to obtain my email)++Contributors:+Michael Steele+Julian Arni
+ Changelog view
@@ -0,0 +1,54 @@++V0.8:+- use Lens library+- use happstack-authenticate 2+- suppress MsgVar and ArrayVar+- add an API based on message passing to allow rules to communicate between them+- new package Library++V0.7:+- full FRP engine for managing events+- dynamic events: event tree is recomputed at each request+- event is now an instance of Monad, MonadPlus+- added typeclass "Shortcut" for interruptible events+- bug fixes, cosmetics++V0.6:+- added composable events: events have now an Applicative and Alternative interfaces+- moved the Engine part from Nomyx-Language to Nomyx-Core. Nomyx-Language now contains only the DSL useful for the player.+- bug fixes, cosmetics++V0.5:+- split the game into 4 packages: Nomyx-Language, Nomyx-Core, Nomyx-Web and Nomyx.+- use Eason for serialization+- use Travis for continuous integration+- protect the game againts malicious codes (a la mueval)+- separate effectful instructions from non effectful instructions in the DSL+- possibility to fork games to test own rules in a sandbox game+- "check rule" button to type check a rule+- bug fixes, cosmetics++V0.4:+- created language APIs+- building on Windows (thanks to Michael Steele)+- tar file for downloading game save files+- outputs includes viewers (not only players)+- splitted Definition into Events, Inputs, Outputs, Players, Variables++V0.3:+- creation of admin role+- inputs made by the rules now include checkboxes, buttons, textarea+- outputs made by the rules are now managed (create, update, delete)+- refactored the GUI+- bumped to GHC 7.6+- compilation errors are displayed in context+- bug fixes++V0.2:+- new login system: you can now login with your Google, Yahoo, Live Journal, Myspace, OpenId or Facebook accounts (thanks to happstack-authenticate)!+- new DSL for voting+- styling: rule code colorized, better settings and help+- use cookies to store the user ID (as suggested on this mailing list)+- new error system to handle exceptions in rules (with ErrorT)+- use lenses+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2012, Corentin Dupont. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+ used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,47 @@+[](https://travis-ci.org/cdupont/Nomyx)+[](https://hackage.haskell.org/package/Nomyx)++Nomyx+=====++A Nomic game in Haskell++Nomyx is a fabulous and strange game where you have the right to change the rules in the middle of the game!+In fact, changing the rules is the goal of the game. Changing a rule is considered as a move. Of course even that could be changed!+In this game, the player can enter new rules in a dedicated language, modify existing ones, thus changing completely the behaviour of the game!++The web site: www.nomyx.net++Installation+============++You need a [Haskell platform](www.haskell.org/platform) running on your system. +To install from the Hackage release, follow this procedure:++ cabal install Nomyx-Language --enable-documentation --haddock-hyperlink-source+ cabal install Nomyx++To install from the GitHub repo:++ git clone git@github.com:cdupont/Nomyx-Language.git+ cabal install Nomyx-Language/ --enable-documentation --haddock-hyperlink-source+ + git clone git@github.com:cdupont/Nomyx.git+ cabal install Nomyx/++Execution+=========++Launch with the command:++ $ Nomyx++and follow the instructions. You may connect using a web browser to the provided address.+++Troubleshooting+===============+See GitHub issues for known bugs.+Tested on Haskell-Platform 2012.1.0.0 and ghc 7.6.3++
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where +> import Distribution.Simple +> main :: IO () +> main = defaultMain +
+ TODO view
@@ -0,0 +1,2 @@+ +Please see https://github.com/cdupont/Nomyx/issues for the todo list
+ nomyx-server.cabal view
@@ -0,0 +1,53 @@+name: nomyx-server+version: 1.0.0+cabal-version: >=1.8+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: corentin.dupont@gmail.com+synopsis: A Nomic game in haskell+description: A Nomic game in Haskell, with a dedicated language to create new rules.+ .+ Nomyx is a fabulous and strange game where you have the right to change the rules in the middle of the game!+ Indeed, changing the rules is the goal of the game. Changing a rule is considered as a move. Of course even that could be changed!+category: game+Homepage: http://www.nomyx.net+author: Corentin Dupont+extra-source-files: AUTHORS README.md TODO Changelog++executable nomyx-server+ build-depends: nomyx-core == 1.0.*,+ nomyx-language == 1.0.*,+ nomyx-web == 1.0.*,+ nomyx-library == 1.0.*,+ nomyx-api == 0.1.*,+ imprevu == 0.1.*,+ base >= 4.6 && <5,+ directory == 1.2.*,+ exceptions >= 0.6 && < 0.9,+ filepath >= 1.3 && < 1.5,+ mtl >= 2.1 && < 2.3,+ network >= 2.4 && < 2.7,+ safe == 0.3.*,+ stm == 2.4.*,+ time >= 1.4 && < 1.7,+ lens >= 4.7 && < 4.15,+ hslogger+ main-is: Main.hs+ buildable: True+ extensions: CPP+ hs-source-dirs: src+ other-modules: Main+ ghc-options: -W -threaded++Test-Suite test+ type: detailed-0.9+ test-module: Test+ hs-source-dirs: test+ build-depends: base,+ nomyx-server == 1.0.0,+ Cabal >= 0.22++source-repository head+ type: git+ location: https://github.com/cdupont/nomyx-server.git
+ src/Main.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Main (main) where++import Control.Concurrent+import Control.Concurrent.STM+import Control.Exception as E hiding (bracket)+import Control.Monad.State+import Data.Maybe+import Data.Time.Clock+import Data.Version (showVersion)+import Network.BSD+import Nomyx.Language hiding (getCurrentTime)+import Nomyx.Core.Engine hiding (runEvaluate)+import Nomyx.Core.Engine.Evaluation hiding (runEvaluate)+import Nomyx.Core.Engine.Test as LT+import Nomyx.Core.Engine.Interpret+import Nomyx.Core.Multi as Multi+import Nomyx.Core.Profile+import Nomyx.Core.Serialize as Serialize+import Nomyx.Core.Session+import Nomyx.Core.Test+import Nomyx.Core.Types+import Nomyx.Core.Utils+import Nomyx.Web.MainPage+import Nomyx.Api.Server (serveApi, putSwaggerYaml)+import Paths_nomyx_server as PN+import Paths_nomyx_language as PNL+import Paths_nomyx_web as PNW+import Paths_nomyx_library as PNLib+import Safe+import System.Console.GetOpt+import System.Directory (canonicalizePath,+ doesFileExist,+ removeDirectoryRecursive,+ removeFile)+import System.Environment+import System.Exit+import System.FilePath ((</>))+import System.Log.Logger+import System.Log.Formatter+import System.Log.Handler hiding (setLevel)+import System.Log.Handler.Simple+import System.Log.Handler.Log4jXML+import System.IO+import Imprevu.Evaluation.TimeEval+import Imprevu.Evaluation.EventEval+import Imprevu.Evaluation.Types+import Control.Lens++-- | Entry point of the program.+main :: IO Bool+main = do+ args <- getArgs+ (flags, _) <- nomyxOpts args+ if Version `elem` flags then putStrLn $ "Nomyx " ++ showVersion PN.version+ else if Help `elem` flags then putStrLn $ usageInfo header options+ else if API `elem` flags then putSwaggerYaml+ else do+ putStrLn "Welcome to Nomyx!"+ putStrLn "Type \"Nomyx --help\" for usage options"+ start flags+ return True++start :: [Flag] -> IO ()+start flags = do+ defWebDir <- PNW.getDataDir+ defSourceDir <- PNL.getDataDir+ defLib <- PNLib.getDataFileName "templates.yaml"+ hostName <- getHostName+ let port = read $ fromMaybe "8000" (findPort flags)+ let host = fromMaybe hostName (findHost flags)+ let adminPass = fromMaybe "NXPSD" (findAdminPass flags)+ let sendMail = SendMails `elem` flags+ let webDir = fromMaybe defWebDir (findWebDir flags) -- data directory: web ressources and profiles+ let sourceDir = fromMaybe defSourceDir (findSourceDir flags) -- source directory: Nomyx-Language files+ let libraryPath = fromMaybe defLib (findLibrary flags)+ let watchdog = fromMaybe 10 (read <$> findWatchdog flags)+ let mLoad = findLoadTest flags+ let verbose = Verbose `elem` flags+ let isTTY = not $ NoTTY `elem` flags+ let mailHost = fromMaybe "" (findMailHost flags)+ let mailLogin = fromMaybe "" (findMailLogin flags)+ let mailPass = fromMaybe "" (findMailPass flags)+ -- save directory: Nomyx.save and uploaded files+ saveDir <- case findTarFile flags of+ Just tarFile -> untar tarFile+ Nothing -> case findSaveDir flags of+ Just f -> canonicalizePath f+ Nothing -> PN.getDataDir+ let mailSettings = MailSettings sendMail mailHost mailLogin mailPass + let settings = Settings (Network host port) mailSettings adminPass saveDir webDir sourceDir watchdog+ when verbose $ putStrLn $ "Directories:\n" ++ "save dir = " ++ saveDir ++ "\nweb dir = " ++ webDir ++ "\nsource dir = " ++ sourceDir+ if Test `elem` flags+ then runTests mLoad watchdog+ else if DeleteSaveFile `elem` flags then cleanFile saveDir+ else mainLoop settings saveDir host port libraryPath isTTY+++mainLoop :: Settings -> FilePath -> HostName -> Port -> FilePath -> Bool -> IO ()+mainLoop settings saveDir host port lib isTTY = do+ startLog $ saveDir </> "nomyx-log.xml"+ serverCommandUsage+ --creating game structures+ multi <- Main.loadMulti settings lib+ --main loop+ withAcid (Just $ saveDir </> profilesDir) $ \acid -> do+ ts <- atomically $ newTVar (Session multi acid)+ --start the web server+ forkIO $ launchWebServer ts (Network host port)+ forkIO $ launchTimeEvents' ts+ when isTTY $ void $ forkIO $ serverLoop ts+ --start the REST API+ serveApi ts++launchTimeEvents' :: TVar Session -> IO ()+launchTimeEvents' tv = do+ now <- getCurrentTime+ debug "tick"+ s <- atomically $ readTVar tv+ let gs = toListOf (multi . gameInfos . traverse . loggedGame . game) s+ let ss = mapM_ (applyTimeEvent now) gs+ s' <- execStateT ss s+ atomically $ writeTVar tv s'+ save (_multi s')+ --sleep 5 second roughly+ threadDelay 5000000+ launchTimeEvents' tv+++loadMulti :: Settings -> FilePath -> IO Multi+loadMulti set libPath = do+ fileExists <- doesFileExist $ getSaveFile set+ if fileExists then do+ info $ "Loading game: " ++ getSaveFile set+ Serialize.loadMulti set `E.catch` (errMsg set)+ else do+ lib <- readLibrary libPath+ let defMulti = defaultMulti set lib+ execStateT (newGame' "Default game" (GameDesc "This is the default game." "") 0 True) defMulti where++errMsg :: Settings -> ErrorCall -> IO Multi+errMsg set e = do+ err $ "Error while loading logged events, log file discarded\n" ++ show (e::ErrorCall)+ return $ defaultMulti set (Library [rAutoActivate] [])++runTests :: Maybe String -> Int -> IO ()+runTests mTestName delay = do+ ts <- playTests mTestName delay+ info $ "\nNomyx Game Tests results:\n" ++ concatMap (\(a,b) -> a ++ ": " ++ show b ++ "\n") ts+ let pass = all snd ts+ info $ "All Tests Pass: " ++ show pass+ if pass then exitSuccess else exitFailure++cleanFile :: FilePath -> IO ()+cleanFile saveDir = do+ info "Deleting save files"+ let catchExp io = io `catch` (\(e::SomeException)-> print e)+ catchExp $ removeDirectoryRecursive $ saveDir </> profilesDir+ catchExp $ removeDirectoryRecursive $ saveDir </> uploadDir+ catchExp $ removeDirectoryRecursive $ saveDir </> authDir+ catchExp $ removeFile $ saveDir </> saveFile+ catchExp $ removeFile $ "nomyx-log.xml"++-- | a loop that will handle server commands+serverLoop :: TVar Session -> IO ()+serverLoop ts = do+ s <- getLine+ case s of+ "d" -> do+ s <- atomically $ readTVar ts+ print $ _multi s+ pfs <- getAllProfiles s+ print pfs+ _ -> putStrLn "command not recognized"+ serverLoop ts++serverCommandUsage :: IO ()+serverCommandUsage = do+ putStrLn "Server commands:"+ putStrLn "d -> debug"+ putStrLn "Ctrl-C -> quit"++-- | Launch mode+data Flag = Verbose+ | Version+ | Test+ | HostName String+ | Port String+ | LoadTest String+ | DeleteSaveFile+ | AdminPass String+ | Help+ | SaveDir FilePath+ | WebDir FilePath+ | SourceDir FilePath+ | TarFile FilePath+ | API+ | Watchdog String+ | LibraryPath FilePath+ | NoTTY+ | SendMails+ | MailHost String+ | MailLogin String+ | MailPass String+ deriving (Show, Eq)++-- | launch options description+options :: [OptDescr Flag]+options =+ [ Option "v" ["verbose"] (NoArg Verbose) "chatty output on stderr"+ , Option "V" ["version"] (NoArg Version) "show version number"+ , Option "h" ["host"] (ReqArg HostName "Hostname") "specify host name"+ , Option "p" ["port"] (ReqArg Port "Port") "specify port"+ , Option "n" ["delete"] (NoArg DeleteSaveFile) "delete all save files"+ , Option "t" ["tests"] (NoArg Test) "perform routine check"+ , Option "l" ["loadtest"] (ReqArg LoadTest "TestName") "specify name of test to load (in combination with -t i.e. -t -l \"testName\")"+ , Option "a" ["adminPass"] (ReqArg AdminPass "AdminPass") "specify the admin password (default is NXPSD)"+ , Option "?" ["help"] (NoArg Help) "display usage options (this screen)"+ , Option "r" ["saveDir"] (ReqArg SaveDir "SaveDir") "specify save directory (for Nomyx.save and uploads)"+ , Option "f" ["dataDir"] (ReqArg WebDir "WebDir") "specify data directory (for profiles and website files)"+ , Option "s" ["sourceDir"] (ReqArg SourceDir "SourceDir") "specify source directory (for Nomyx-Language files)"+ , Option "T" ["tar"] (ReqArg TarFile "TarFile") "specify tar file (containing Nomyx.save and uploads)"+ , Option "" ["api"] (NoArg API) "get swagger API file"+ , Option "" ["watchdog"] (ReqArg Watchdog "5") "time in seconds before killing the compilation thread"+ , Option "" ["library"] (ReqArg LibraryPath "Library path") "specify the path of a library of rules (yaml file)"+ , Option "" ["noTTY"] (NoArg NoTTY) "Start headless"+ , Option "m" ["mails"] (NoArg SendMails) "send mails to players when a new rule is posted (default is no)"+ , Option "" ["mailHost"] (ReqArg MailHost "MailHost") "mail host (e.g. smtp.gmail.com)"+ , Option "" ["mailLogin"] (ReqArg MailLogin "MailLogin") "mail login (e.g. nomyx@gmail.com)"+ , Option "" ["mailPass"] (ReqArg MailPass "MailPass") "mail password"+ ]++nomyxOpts :: [String] -> IO ([Flag], [String])+nomyxOpts argv =+ case getOpt Permute options argv of+ (o,n,[] ) -> return (o,n)+ (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))++header :: String+header = "Usage: Nomyx [OPTION...]"++findPort, findHost, findLoadTest, findSaveDir, findWebDir, findSourceDir, findAdminPass, findTarFile, findWatchdog :: [Flag] -> Maybe String+findPort fs = listToMaybe [a | Port a <- fs]+findHost fs = listToMaybe [a | HostName a <- fs]+findLoadTest fs = listToMaybe [a | LoadTest a <- fs]+findSaveDir fs = listToMaybe [a | SaveDir a <- fs]+findWebDir fs = listToMaybe [a | WebDir a <- fs]+findSourceDir fs = listToMaybe [a | SourceDir a <- fs]+findAdminPass fs = listToMaybe [a | AdminPass a <- fs]+findTarFile fs = listToMaybe [a | TarFile a <- fs]+findWatchdog fs = listToMaybe [a | Watchdog a <- fs]+findLibrary fs = listToMaybe [a | LibraryPath a <- fs]+findMailHost fs = listToMaybe [a | MailHost a <- fs]+findMailLogin fs = listToMaybe [a | MailLogin a <- fs]+findMailPass fs = listToMaybe [a | MailPass a <- fs]++warn, info :: (MonadIO m) => String -> m ()+debug s = liftIO $ debugM "Nomyx.Main" s+info s = liftIO $ infoM "Nomyx.Main" s+warn s = liftIO $ warningM "Nomyx.Main" s+err s = liftIO $ errorM "Nomyx.Main" s+ ++startLog :: FilePath -> IO ()+startLog fp = do+ stdoutHandler <- do+ lh <- streamHandler stdout INFO+ return $ setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg")+ log4jHandler <- log4jFileHandler fp DEBUG+ + updateGlobalLogger rootLoggerName removeHandler+ updateGlobalLogger "Nomyx" (addHandler stdoutHandler)+ updateGlobalLogger rootLoggerName (addHandler log4jHandler)+ updateGlobalLogger rootLoggerName (setLevel DEBUG)
+ test/Test.hs view
@@ -0,0 +1,9 @@+module Test where++import Nomyx.Core.Engine.Test+import Distribution.TestSuite++tests :: IO [Test]+tests = return []++