init admin, location

This commit is contained in:
Filip Graliński 2018-06-01 16:30:35 +02:00
parent f771b04f69
commit 4f20a5ee0c
5 changed files with 49 additions and 2 deletions

View File

@ -29,6 +29,9 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr)
import Crypto.PasswordStore
import Yesod.Auth.HashDB (defaultStrength)
import qualified Data.IntMap as IntMap
-- Import all relevant handler modules here.
@ -92,11 +95,33 @@ makeFoundation appSettings = do
(pgPoolSize $ appDatabaseConf appSettings)
-- Perform database migration using our application's logging settings.
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
runLoggingT (runSqlPool ((runMigration migrateAll) >> (initAdmin (appAdminUser appSettings) (appAdminPassword appSettings))) pool) logFunc
-- Return the foundation
return $ mkFoundation pool
initAdmin Nothing Nothing = return ()
initAdmin (Just "") _ = return ()
initAdmin (Just adminUser) (Just adminPass) = do
mUserEnt <- getBy $ UniqueUser adminUser
case mUserEnt of
Just _ -> return ()
Nothing -> do
passwordEncoded <- liftIO $ makePassword (encodeUtf8 adminPass) defaultStrength
_ <- insert User
{ userIdent = adminUser
, userPassword = Just $ decodeUtf8 passwordEncoded
, userName = Nothing
, userIsAdmin = True
, userLocalId = Nothing
, userIsAnonymous = False
, userAvatar = Nothing
, userVerificationKey = Nothing
, userKeyExpirationDate = Nothing
, userTriggerToken = Nothing
}
return ()
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares.
makeApplication :: App -> IO Application

View File

@ -55,6 +55,12 @@ data AppSettings = AppSettings
, appVarDir :: String
-- ^ Contact (admin) e-mail
, appContactEmail :: Maybe Text
-- ^ Ident of an admin to be created when starting
, appAdminUser :: Maybe Text
-- ^ Password for an admin to be created when starting
, appAdminPassword :: Maybe Text
-- ^ Additional info for the instance
, appLocation :: Maybe Text
}
instance FromJSON AppSettings where
@ -83,6 +89,10 @@ instance FromJSON AppSettings where
appVarDir <- o .: "var-dir"
appContactEmail <- o .:? "contact-email"
appAdminUser <- o .:? "admin-user"
appAdminPassword <- o .:? "admin-password"
appLocation <- o .:? "location"
return AppSettings {..}
-- | Settings for 'widgetFile', such as which template languages to support and

View File

@ -28,4 +28,9 @@ database:
poolsize: "_env:PGPOOLSIZE:10"
copyright: © Filip Graliński
admin-user: "_env:ADMINUSER:"
admin-password: "_env:ADMINPASS:"
location: "_env:LOCATION:"
#analytics: UA-YOURCODE

View File

@ -2,6 +2,9 @@
<div class="container">
<div class="navbar-header">
<a class="navbar-brand" href="@{HomeR}">Gonito.net
$maybe location <- appLocation $ appSettings master
$if location /= ""
\@#{location}
$maybe user <- maybeUser
<ul class="nav navbar-nav">

View File

@ -1,6 +1,10 @@
<div class="container">
<div class="jumbotron">
<h1>Welcome to Gonito.net!
<h1>Welcome to Gonito.net
$maybe location <- appLocation $ appSettings master
$if location /= ""
\@#{location}
!
<p>Gonito (pronounced <i>ɡɔ̃ˈɲitɔ</i>) is a Kaggle<sup><a href="#disclaimer">*</a></sup>-like platform for machine learning competitions.
<div class="panel panel-default">