diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/T3/DB.hs b/src/T3/DB.hs new file mode 100644 --- /dev/null +++ b/src/T3/DB.hs @@ -0,0 +1,18 @@ +{-# OPTIONS -fno-warn-orphans #-} +module T3.DB where + +import qualified Data.Map as M +import T3.Server +import T3.Server.Dispatch +import T3.Server.Lobby +import T3.Match +import T3.Random +import T3.Playback +import T3.Game.Core + +class Monad m => DB m where + storeUsers :: M.Map UserName UserKey -> m () + loadUsers :: m (M.Map UserName UserKey) + loadMatchList :: m [MatchId] + storePlayback :: Playback -> m () + loadPlayback :: MatchId -> m (Maybe Playback) diff --git a/src/T3/Match.hs b/src/T3/Match.hs new file mode 100644 --- /dev/null +++ b/src/T3/Match.hs @@ -0,0 +1,136 @@ +module T3.Match + ( module T3.Match.Types + , Seconds(..) + , runMatch + , UserInit + , Callback + , StartCallback + , delay + ) where + +import Prelude +import T3.Match.Types +import T3.Game +import Control.Concurrent +import Control.Concurrent.Async +import Control.Monad.Trans.Either + +import Control.Monad.State.Strict + +type Callback = Step -> IO () +type StartCallback = MatchInfo -> Users -> Step -> IO () + +newtype Seconds = Seconds Int + deriving (Num, Show, Eq, Ord, Enum) + +data MatchData = MatchData + { matchReq :: XO -> IO (Loc, Callback) + , matchRespX :: Callback + , matchRespO :: Callback + , matchLog :: [Action] -> Board -> Result -> IO () + , matchBoard :: Board + , matchActions :: [Action] + , matchTimeoutLimit :: Maybe Seconds + } + +newtype Match a = Match { unMatch :: StateT MatchData (EitherT (IO ()) IO) a } + deriving (Functor, Applicative, Monad, MonadIO, MonadState MatchData) + +type UserInit = (Callback, IO (Loc, Callback)) + +runMatch :: Maybe Seconds -> UserInit -> UserInit -> ([Action] -> Board -> Result -> IO ()) -> IO () -> IO () +runMatch timeoutLimit (xCB, xReq) (oCB, oReq) logger done = do + let req X = xReq + req O = oReq + let cb X = xCB + cb O = oCB + let b = emptyBoard + let matchDat = MatchData req (cb X) (cb O) logger b [] timeoutLimit + matchResult <- runEitherT (evalStateT (unMatch $ run b) matchDat) + either id (const $ return ()) matchResult + done + +sendGameState :: XO -> Match () +sendGameState xo = do + s <- get + liftIO $ (respXO xo s) (Step (matchBoard s) Nothing) + +delay :: Seconds -> IO () +delay (Seconds n) = threadDelay (n * 1000000) + +recvAction :: XO -> Match Loc +recvAction xo = do + req <- gets (flip matchReq xo) + s <- get + let timeoutResponse = forfeitIO s (Win $ yinYang xo) (Lose xo) + timeoutOrLoc <- liftIO $ + maybe + (fmap Right req) + (\secs -> race (delay secs >> return timeoutResponse) req) + (matchTimeoutLimit s) + case timeoutOrLoc of + Left timeout -> Match (lift $ left timeout) + Right (loc, resp) -> do + updateResp resp + return loc + where + updateResp resp = do + match <- get + put $ case xo of + X -> match { matchRespX = resp } + O -> match { matchRespO = resp } + +sendFinal :: XO -> Final -> Match () +sendFinal xo final = do + s <- get + liftIO $ sendFinalIO s xo final + +sendFinalIO :: MatchData -> XO -> Final -> IO () +sendFinalIO s xo final = liftIO $ (respXO xo s) (Step (matchBoard s) (Just final)) + +tally :: Result -> Match () +tally res = do + s <- get + liftIO $ matchLog s (matchActions s) (matchBoard s) res + +tallyIO :: MatchData -> Result -> IO () +tallyIO s res = matchLog s (matchActions s) (matchBoard s) res + +forfeitIO :: MatchData -> Win XO -> Lose XO -> IO () +forfeitIO s (Win w) (Lose l) = do + tallyIO s (Winner w) + sendFinalIO s w WonByDQ + sendFinalIO s l LossByDQ + +updateBoard :: Board -> Match () +updateBoard b = do + match <- get + put $ match { matchBoard = b } + +logAction :: XO -> Loc -> Match () +logAction xo loc = do + match <- get + put $ match { matchActions = matchActions match ++ [Action xo loc] } + +respXO :: XO -> MatchData -> Callback +respXO X = matchRespX +respXO O = matchRespO + +instance Game Match where + move xo = do + sendGameState xo + recvAction xo + forfeit w l = do + s <- get + liftIO $ forfeitIO s w l + end (Win w) (Lose l) = do + tally (Winner w) + sendFinal w Won + sendFinal l Loss + tie = do + tally Tie + sendFinal X Tied + sendFinal O Tied + step b xo loc = do + logAction xo loc + updateBoard b diff --git a/src/T3/Match/Types.hs b/src/T3/Match/Types.hs new file mode 100644 --- /dev/null +++ b/src/T3/Match/Types.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DeriveGeneric #-} +-- {-# LANGUAGE DeriveAnyClass #-} +-- {-# LANGUAGE FlexibleContexts #-} + +module T3.Match.Types where + +import GHC.Generics +import Control.Monad (mzero) +import Data.Char (toLower) +import Data.Aeson +import Data.Aeson.Types +import Data.Text (Text) +import T3.Game +import T3.Game.Core + +newtype UserName = UserName Text + deriving (Show, Eq, Ord, FromJSON, ToJSON) + +newtype MatchId = MatchId Text + deriving (Show, Eq, Ord, FromJSON, ToJSON) + +newtype MatchToken = MatchToken Text + deriving (Show, Eq, Ord, FromJSON, ToJSON) + +data Users = Users + { uX :: UserName + , uO :: UserName + } deriving (Show, Eq, Generic) + +instance FromJSON Users where + parseJSON = dropPrefixP "u" + +instance ToJSON Users where + toJSON = dropPrefixJ "u" + +data MatchInfo = MatchInfo + { miMatchId :: MatchId + , miMatchToken :: MatchToken + } deriving (Show, Eq, Generic) + +instance FromJSON MatchInfo where + parseJSON = dropPrefixP "mi" + +instance ToJSON MatchInfo where + toJSON = dropPrefixJ "mi" + +data Step = Step + { stepBoard :: Board + , stepFinal :: Maybe Final + } deriving (Show, Eq) + +data Final + = Won + | WonByDQ + | Loss + | LossByDQ + | Tied + deriving (Show, Eq) + +instance FromJSON Final where + parseJSON (String "Won") = pure Won + parseJSON (String "WonByDQ") = pure WonByDQ + parseJSON (String "Loss") = pure Loss + parseJSON (String "LossByDQ") = pure LossByDQ + parseJSON (String "Tied") = pure Tied + parseJSON _ = mzero + +instance ToJSON Final where + toJSON f = String $ case f of + Won -> "Won" + WonByDQ -> "WonByDQ" + Loss -> "Loss" + LossByDQ -> "LossByDQ" + Tied -> "Tied" diff --git a/src/T3/Playback.hs b/src/T3/Playback.hs new file mode 100644 --- /dev/null +++ b/src/T3/Playback.hs @@ -0,0 +1,54 @@ +{-# OPTIONS -fno-warn-orphans #-} +module T3.Playback where + +import Control.Monad (mzero) +import T3.Game +import T3.Match +import T3.Server () +import Data.Aeson hiding (Result) +import qualified Data.Text as T +import qualified Data.ByteString.Lazy as BL +import qualified Data.HashMap.Lazy as HML + +data Playback = Playback + { pbMatchId :: MatchId + , pbUsers :: Users + , pbActions :: [Action] + , pbResult :: Result + } deriving (Show, Eq) + +writePlayback :: FilePath -> Playback -> IO () +writePlayback prefix pb = BL.writeFile path (encode pb) + where + (MatchId matchIdText) = pbMatchId pb + path = prefix `mappend` (T.unpack $ matchIdText `mappend` ".json") + +instance ToJSON Playback where + toJSON pb = object + [ "matchId" .= pbMatchId pb + , "users" .= pbUsers pb + , "actions" .= pbActions pb + , "result" .= pbResult pb + ] + +instance FromJSON Playback where + parseJSON (Object o) = Playback + <$> o .: "matchId" + <*> o .: "users" + <*> o .: "actions" + <*> o .: "result" + +instance ToJSON Result where + toJSON Tie = object [ "tag" .= String "tie" ] + toJSON Unfinished = object [ "tag" .= String "unfinished" ] + toJSON (Winner xo) = object [ "tag" .= String "decision", "winner" .= xo, "loser" .= yinYang xo ] + +instance FromJSON Result where + parseJSON (Object o) = case HML.lookup "tag" o of + Just (String "tie") -> pure Tie + Just (String "unfinished") -> pure Unfinished + Just (String "decision") -> case HML.lookup "winner" o of + Just xo -> Winner <$> parseJSON xo + _ -> mzero + _ -> mzero + parseJSON _ = mzero diff --git a/src/T3/Random.hs b/src/T3/Random.hs new file mode 100644 --- /dev/null +++ b/src/T3/Random.hs @@ -0,0 +1,18 @@ +module T3.Random where + +import Data.Map (keys) +import T3.Game.Core +import Control.Monad.Random +import Data.List (notElem) + +randomLoc :: MonadRandom m => Board -> m (Maybe Loc) +randomLoc b + | null available = return Nothing + | otherwise = do + r <- getRandom + let idx = r `mod` (length available) + return $ Just (available !! idx) + where + available = filter (flip notElem taken) allLocs + taken = keys (boardMap b) + allLocs = [Loc x y | x <- [0..2], y <- [0..2]] diff --git a/src/T3/Server.hs b/src/T3/Server.hs new file mode 100644 --- /dev/null +++ b/src/T3/Server.hs @@ -0,0 +1,220 @@ +{-# OPTIONS -fno-warn-orphans #-} +{-# LANGUAGE DeriveGeneric #-} +module T3.Server + ( GameLogger + , Server(..) + , UserConfig(..) + , MatchConfig(..) + , UserCreds(..) + , StartRequest(..) + , PlayRequest(..) + , GameState(..) + , Users(..) + , StartResponse(..) + , PlayResponse(..) + , UserName(..) + , UserKey(..) + , RegisterRequest(..) + , RegisterResponse(..) + , forkServer + , genBase64 + , genMatchToken + , genMatchId + , genUserName + , genUserKey + , authenticate + , authorize + , toGameState + ) where + +import qualified Data.Map as M +import qualified Data.Text as T + +import Control.Applicative +import Control.Concurrent +import Control.Concurrent.STM +import Control.Monad +import Data.Aeson hiding (Result) +import Data.Aeson.Types (Options(..), defaultOptions, Parser) +import Data.Text (Text) +import System.Random +import GHC.Generics +import Data.Char + +import T3.Game +import T3.Server.Dispatch +import T3.Server.Lobby +import T3.Match + +type GameLogger = MatchId -> Users -> [Action] -> Board -> Result -> IO () + +data Server = Server + { srvLobby :: TVar Lobby + , srvMatches :: TVar (M.Map MatchId MatchConfig) + , srvUsers :: TVar (M.Map UserName UserKey) + , srvDie :: IO () + , srvLogger :: GameLogger + , srvTimeoutLimit :: Maybe Seconds + } + +authenticate :: Server -> UserCreds -> STM Bool +authenticate srv uc = do + users <- readTVar (srvUsers srv) + return $ M.lookup (ucName uc) users == Just (ucKey uc) + +authorize :: UserName -> MatchToken -> MatchConfig -> Maybe UserConfig +authorize userName matchToken matchCfg = (userCfgMay $ matchCfgX matchCfg) <|> (userCfgMay $ matchCfgO matchCfg) + where + userCfgMay cfg = + if userCfgUserName cfg == userName && userCfgMatchToken cfg == matchToken + then Just cfg + else Nothing + +forkServer :: GameLogger -> Maybe Seconds -> M.Map UserName UserKey -> IO Server +forkServer logger timeoutLimit users = do + lobby <- newTVarIO [] + matches <- newTVarIO M.empty + users <- newTVarIO users + let srv = Server lobby matches users (return ()) logger timeoutLimit + thid <- forkIO $ serve srv + let killMatches = do + killers <- atomically $ do + s <- readTVar matches + return $ map matchCfgDie (M.elems s) + sequence_ killers + return srv { srvDie = killMatches >> killThread thid } + +genBase64 :: Int -> IO Text +genBase64 n = fmap T.pack (sequence $ replicate n gen) + where + gen = fmap (\x -> vals !! (mod x len)) randomIO + len = length vals + vals = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['-','_'] + +genMatchToken :: IO MatchToken +genMatchToken = MatchToken <$> genBase64 16 + +genMatchId :: IO MatchId +genMatchId = MatchId <$> genBase64 16 + +genUserName :: IO UserName +genUserName = UserName <$> genBase64 32 + +genUserKey :: IO UserKey +genUserKey = UserKey <$> genBase64 32 + +serve :: Server -> IO () +serve srv = do + musers <- userPairFromLobby (srvLobby srv) + case musers of + Nothing -> return () + Just ((xUN, xCB), (oUN, oCB)) -> do + matchId <- genMatchId + xGT <- genMatchToken + oGT <- genMatchToken + let removeSelf = atomically $ modifyTVar (srvMatches srv) (M.delete matchId) + let users = Users { uX = xUN, uO = oUN } + let xMatchInfo = MatchInfo { miMatchId = matchId, miMatchToken = xGT } + let oMatchInfo = MatchInfo { miMatchId = matchId, miMatchToken = oGT } + sessCfg <- forkMatch + (srvTimeoutLimit srv) + (xUN, xGT, xCB xMatchInfo users) + (oUN, oGT, oCB oMatchInfo users) + (srvLogger srv matchId users) + removeSelf + atomically $ modifyTVar (srvMatches srv) (M.insert matchId sessCfg) + threadDelay (1 * 1000000) -- 1 second + serve srv + +toGameState :: Step -> GameState +toGameState s = GameState (stepBoard s) (stepFinal s) + +-- + +newtype UserKey = UserKey Text + deriving (Show, Eq, Ord, FromJSON, ToJSON) + +data RegisterRequest = RegisterRequest + { rreqName :: UserName + } deriving (Show, Eq, Generic) + +instance FromJSON RegisterRequest where + parseJSON = dropPrefixP "rreq" + +instance ToJSON RegisterRequest where + toJSON = dropPrefixJ "rreq" + +data RegisterResponse = RegisterResponse + { rrespCreds :: UserCreds + } deriving (Show, Eq, Generic) + +instance FromJSON RegisterResponse where + parseJSON = dropPrefixP "rresp" + +instance ToJSON RegisterResponse where + toJSON = dropPrefixJ "rresp" + +data UserCreds = UserCreds + { ucName :: UserName + , ucKey :: UserKey + } deriving (Show, Eq, Generic) + +instance FromJSON UserCreds where + parseJSON = dropPrefixP "uc" + +instance ToJSON UserCreds where + toJSON = dropPrefixJ "uc" + +data StartRequest = StartRequest + { sreqCreds :: UserCreds + } deriving (Show, Eq, Generic) + +instance FromJSON StartRequest where + parseJSON = dropPrefixP "sreq" + +instance ToJSON StartRequest where + toJSON = dropPrefixJ "sreq" + +data PlayRequest = PlayRequest + { preqCreds :: UserCreds + , preqLoc :: Loc + } deriving (Show, Eq, Generic) + +instance FromJSON PlayRequest where + parseJSON = dropPrefixP "preq" + +instance ToJSON PlayRequest where + toJSON = dropPrefixJ "preq" + +data StartResponse = StartResponse + { srespMatchInfo :: MatchInfo + , srespUsers :: Users + , srespState :: GameState + } deriving (Show, Eq, Generic) + +instance FromJSON StartResponse where + parseJSON = dropPrefixP "sresp" + +instance ToJSON StartResponse where + toJSON = dropPrefixJ "sresp" + +data PlayResponse = PlayResponse + { prespState :: GameState + } deriving (Show, Eq, Generic) + +instance FromJSON PlayResponse where + parseJSON = dropPrefixP "presp" + +instance ToJSON PlayResponse where + toJSON = dropPrefixJ "presp" + +data GameState = GameState + { gsBoard :: Board + , gsFinal :: Maybe Final + } deriving (Show, Eq, Generic) + +instance FromJSON GameState where + parseJSON = dropPrefixP "gs" + +instance ToJSON GameState where + toJSON = dropPrefixJ "gs" diff --git a/src/T3/Server/Dispatch.hs b/src/T3/Server/Dispatch.hs new file mode 100644 --- /dev/null +++ b/src/T3/Server/Dispatch.hs @@ -0,0 +1,36 @@ +module T3.Server.Dispatch where + +import Prelude +import Control.Concurrent +import T3.Game +import T3.Match + +data UserConfig = UserConfig + { userCfgUserName :: UserName + , userCfgMatchToken :: MatchToken + , userCfgSendLoc :: (Loc, Callback) -> IO () + } + +data MatchConfig = MatchConfig + { matchCfgX :: UserConfig + , matchCfgO :: UserConfig + , matchCfgDie :: IO () + } + +forkMatch + :: Maybe Seconds + -> (UserName, MatchToken, Callback) + -> (UserName, MatchToken, Callback) + -> ([Action] -> Board -> Result -> IO ()) + -> IO () + -> IO MatchConfig +forkMatch timeoutLimit (xUI, xGT, xCB) (oUI, oGT, oCB) logger done = do + xChan <- newChan + oChan <- newChan + let x = (xCB, readChan xChan) + let o = (oCB, readChan oChan) + thid <- forkIO $ runMatch timeoutLimit x o logger done + return $ MatchConfig + (UserConfig xUI xGT (writeChan xChan)) + (UserConfig oUI oGT (writeChan oChan)) + (killThread thid >> done) diff --git a/src/T3/Server/Lobby.hs b/src/T3/Server/Lobby.hs new file mode 100644 --- /dev/null +++ b/src/T3/Server/Lobby.hs @@ -0,0 +1,34 @@ +module T3.Server.Lobby where + +import Prelude +import Control.Monad +import Control.Concurrent.STM +import System.Random +import Data.Maybe +import T3.Match + +type Lobby = [(UserName, StartCallback)] + +addUserToLobby :: TVar Lobby -> UserName -> (StartCallback) -> IO Bool +addUserToLobby lobby un cb = atomically $ do + lob <- readTVar lobby + let shouldAdd = isNothing (lookup un lob) + when shouldAdd $ writeTVar lobby ((un, cb) : lob) + return shouldAdd + +userPairFromLobby :: TVar Lobby -> IO (Maybe ((UserName, StartCallback), (UserName, StartCallback))) +userPairFromLobby lobby = do + a <- randomIO + b <- randomIO + atomically $ do + lob <- readTVar lobby + let len = length lob + if len < 2 then return Nothing else grabEm lob (mod a len) (mod b (len - 1)) + where + grabEm lob i j = do + let (x, lob') = grab lob i + let (y, lob'') = grab lob' j + writeTVar lobby lob'' + return $ Just (x, y) + grab :: [a] -> Int -> (a, [a]) + grab xs idx = (xs !! idx, take idx xs ++ drop (idx + 1) xs) diff --git a/src/T3/Web.hs b/src/T3/Web.hs new file mode 100644 --- /dev/null +++ b/src/T3/Web.hs @@ -0,0 +1,137 @@ +module T3.Web where + +import qualified Data.Map as M +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import Control.Applicative +import Control.Concurrent +import Control.Concurrent.Async +import Control.Concurrent.STM +import Control.Monad (mzero, forever) +import Data.Aeson +import Data.IORef +import Data.Maybe +import T3.Server +import T3.Server.Dispatch +import T3.Server.Lobby +import T3.DB +import T3.Match +import T3.Random +import T3.Game.Core +import Control.Monad.Trans (MonadIO, liftIO) + +class (MonadIO m) => HttpHandler m where + httpRequestEntity :: m BL.ByteString + server :: m Server + unauthorized :: m a + badRequest :: m a + badFormat :: m a + alreadyInLobby :: m a + -- + httpJSONEntity :: FromJSON a => m (Maybe a) + httpJSONEntity = fmap decode httpRequestEntity + +play :: HttpHandler m => MatchId -> MatchToken -> Maybe PlayRequest -> m PlayResponse +play matchId matchToken mPlayRequest = do + srv <- server + case mPlayRequest of + Nothing -> badFormat + Just playReq -> do + mUserCfg <- liftIO . atomically $ do + let creds = preqCreds playReq + authenicated <- authenticate srv creds + if not authenicated + then return Nothing + else do + mMatchCfg <- M.lookup matchId <$> readTVar (srvMatches srv) + return $ authorize (ucName creds) matchToken =<< mMatchCfg + case mUserCfg of + Nothing -> unauthorized + Just userCfg -> do + resp <- liftIO newEmptyMVar + liftIO $ (userCfgSendLoc userCfg) (preqLoc playReq, putMVar resp . PlayResponse . toGameState) + mPresp <- liftIO $ (either id id) <$> race (Just <$> takeMVar resp) (delay (Seconds 60) >> return Nothing) + fromMaybe badRequest (return <$> mPresp) + +start :: HttpHandler m => Maybe StartRequest -> m StartResponse +start mStartReq = do + srv <- server + case mStartReq of + Nothing -> badFormat + Just startReq -> do + resp <- liftIO newEmptyMVar + authenticated <- liftIO . atomically $ authenticate srv (sreqCreds startReq) + if not authenticated + then unauthorized + else do + added <- liftIO $ addUserToLobby + (srvLobby srv) + (ucName $ sreqCreds startReq) + (\matchInfo users step -> putMVar resp $ StartResponse matchInfo users (toGameState step)) + if added + then do + sresp <- liftIO $ takeMVar resp + return sresp + else alreadyInLobby + +randomHandler :: HttpHandler m => Maybe StartRequest -> m StartResponse +randomHandler mStartReq = do + case mStartReq of + Nothing -> badFormat + Just startReq -> do + srv <- server + authenticated <- liftIO . atomically $ authenticate srv (sreqCreds startReq) + if not authenticated + then unauthorized + else do + matchId <- liftIO genMatchId + xGT <- liftIO genMatchToken + oGT <- liftIO genMatchToken + randomStep <- liftIO newEmptyMVar + let randomCB = putMVar randomStep + randomSendLocRef <- liftIO $ newIORef (const $ return ()) + randomThid <- liftIO . forkIO . forever $ do + step <- takeMVar randomStep + mLoc <- randomLoc (stepBoard step) + case mLoc of + Nothing -> return () + Just loc -> do + sendLoc <- readIORef randomSendLocRef + sendLoc (loc, randomCB) + let xUN = (ucName . sreqCreds) startReq + let oUN = UserName "random" + let removeSelf = do + killThread randomThid + atomically $ modifyTVar (srvMatches srv) (M.delete matchId) + let users = Users { uX = xUN, uO = oUN } + let xMatchInfo = MatchInfo { miMatchId = matchId, miMatchToken = xGT } + sessCfg <- liftIO $ forkMatch + (srvTimeoutLimit srv) + (xUN, xGT, const $ return ()) + (oUN, oGT, randomCB) + (\_ _ _ -> return ()) + removeSelf + liftIO $ writeIORef randomSendLocRef (userCfgSendLoc $ matchCfgO sessCfg) + liftIO . atomically $ modifyTVar (srvMatches srv) (M.insert matchId sessCfg) + return $ StartResponse xMatchInfo Users{ uX = xUN, uO = oUN } (GameState emptyBoard Nothing) + +register :: (HttpHandler m, DB m) => Maybe RegisterRequest -> m (Maybe RegisterResponse) +register Nothing = badFormat +register (Just rreq) = do + let name@(UserName un) = rreqName rreq + srv <- server + if T.null un + then return Nothing + else do + userKey <- liftIO genUserKey + mUsers <- liftIO . atomically $ do + users <- readTVar (srvUsers srv) + let users' = M.insert name userKey users + if M.member name users + then return Nothing + else writeTVar (srvUsers srv) users' >> return (Just users') + case mUsers of + Nothing -> return Nothing + Just users -> do + storeUsers users + return . Just $ RegisterResponse (UserCreds name userKey) diff --git a/t3-server.cabal b/t3-server.cabal new file mode 100644 --- /dev/null +++ b/t3-server.cabal @@ -0,0 +1,63 @@ +name: t3-server +synopsis: tic-tac-toe server +description: Please see README.md +version: 0.1.0 +cabal-version: >= 1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +author: Joe Vargas +maintainer: http://github.com/jxv +copyright: 2016 Joe Vargas +category: Game + +library + hs-source-dirs: + src + exposed-modules: + T3.Playback + T3.Random + T3.Web + T3.DB + T3.Server + T3.Server.Dispatch + T3.Server.Lobby + T3.Match + T3.Match.Types + + default-extensions: + OverlappingInstances + OverloadedStrings + MultiParamTypeClasses + TypeFamilies + GADTs + GeneralizedNewtypeDeriving + FlexibleContexts + FlexibleInstances + EmptyDataDecls + TupleSections + + build-depends: + base >= 4 && < 5 + , bytestring >= 0.9 && < 0.11 + , text >= 0.11 && < 2.0 + , aeson >= 0.6 && < 0.11 + , safe + , unordered-containers + , containers + , vector + , time + , case-insensitive + , wai + , async + , mtl + , stm + , random + , hashable + , hashmap + , either + , t3-game + , random + , MonadRandom + default-language: + Haskell2010