diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,5 @@ +Corentin Dupont (remove DELAVEGA to obtain my email) + +Contributors: +Michael Steele +Julian Arni diff --git a/Changelog b/Changelog new file mode 100644 --- /dev/null +++ b/Changelog @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,47 @@ +[![Build Status](https://travis-ci.org/cdupont/Nomyx.png?branch=master)](https://travis-ci.org/cdupont/Nomyx) +[![Hackage](https://budueba.com/hackage/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 + + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,6 @@ +#!/usr/bin/runhaskell +> module Main where +> import Distribution.Simple +> main :: IO () +> main = defaultMain + diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,2 @@ + +Please see https://github.com/cdupont/Nomyx/issues for the todo list diff --git a/nomyx-server.cabal b/nomyx-server.cabal new file mode 100644 --- /dev/null +++ b/nomyx-server.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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) diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,9 @@ +module Test where + +import Nomyx.Core.Engine.Test +import Distribution.TestSuite + +tests :: IO [Test] +tests = return [] + +