swarm/app/tournament/Main.hs
Karl Ostmo 82e8ac95ad
Implement GitHub authentication (#1856)
Closes #1847.

## Demo

### Production
https://swarmgame.net/list-games.html

### Local testing
```
tournament/scripts/demo/server-native.sh
```
and

```
scripts/test/run-tests.sh swarm:test:tournament-host
```

## Authentication flow

1. Users are represented by a GitHub username (primary key) and an "authentication cookie" in the SQLite database.
2. Site prompts user to login when the client's cookie is nonexistent or does not match any user in the database.
3. GitHub flow:
    1. Clicking the "Login" link redirects user to the GitHub login page.
    2. GitHub sends a `code` to our callback URL.
    3. use that `code` to get an "access token"
    4. use the "access token" to look up the username of the person who is logging in.
    5. generate and store a new cookie in the database row for that username
    6. set the cookie value on the user's client.
4. As long as the client keeps sending the cookie value known to the server, all uploads/activity will be attributed to their GitHub username.

## New features

* Login/Logout
* All uploaded content is attributed to an authenticated GitHub user
* Separate pages for scenario lists and solution lists
* Download a solution file
2024-05-22 00:27:21 +00:00

101 lines
2.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Main where
import Control.Monad.Trans.Reader (runReaderT)
import Data.Maybe (fromMaybe)
import Data.Yaml (decodeFileThrow)
import Database.SQLite.Simple (execute_, withConnection)
import Network.Wai.Handler.Warp (Port)
import Options.Applicative
import Swarm.Game.State (Sha1 (..))
import Swarm.Web.Tournament
import Swarm.Web.Tournament.Database.Query
import Swarm.Web.Tournament.Type (UserAlias (..))
data AppOpts = AppOpts
{ userWebPort :: Maybe Port
-- ^ Explicit port on which to run the web API
, gameGitVersion :: Sha1
, deploymentEnv :: DeploymentEnvironment
}
webPort :: Parser (Maybe Int)
webPort =
optional $
option
auto
( long "port"
<> metavar "PORT"
<> help ("Set the web service port (or disable it with 0). Default to " <> show defaultPort <> ".")
)
gameVersion :: Parser Sha1
gameVersion =
Sha1
<$> option
str
( long "version"
<> metavar "VERSION"
<> help "Set the git version of the game"
)
parseRunningLocally :: Parser DeploymentEnvironment
parseRunningLocally =
flag
ProdDeployment
(LocalDevelopment $ UserAlias "local-user")
(long "local" <> help "Running locally for development")
cliParser :: Parser AppOpts
cliParser = AppOpts <$> webPort <*> gameVersion <*> parseRunningLocally
cliInfo :: ParserInfo AppOpts
cliInfo =
info
(cliParser <**> helper)
( header "Swarm tournament"
<> progDesc "Hosts a tournament server."
<> fullDesc
)
main :: IO ()
main = do
opts <- execParser cliInfo
creds <- case deploymentEnv opts of
LocalDevelopment _ -> return $ GitHubCredentials "" ""
ProdDeployment -> decodeFileThrow "swarm-github-app-credentials.yaml"
webMain
(AppData (gameGitVersion opts) creds persistenceFunctions (deploymentEnv opts))
(fromMaybe defaultPort $ userWebPort opts)
where
persistenceFunctions =
PersistenceLayer
{ scenarioStorage =
ScenarioPersistence
{ lookupCache = withConn lookupScenarioSolution
, storeCache = withConn insertScenario
, getContent = withConn lookupScenarioContent
}
, solutionStorage =
ScenarioPersistence
{ lookupCache = withConn lookupSolutionSubmission
, storeCache = withConn insertSolutionSubmission
, getContent = withConn lookupSolutionContent
}
, authenticationStorage =
AuthenticationStorage
{ usernameFromCookie = withConn getUsernameFromCookie
, cookieFromUsername = withConn insertCookie
}
}
where
withConn f x =
withConnection databaseFilename $ \conn -> do
execute_ conn "PRAGMA foreign_keys = ON;"
runReaderT (f x) conn