First steps...
This commit is contained in:
parent
d1808ad4d7
commit
7b18752be2
@ -14,7 +14,7 @@ module Application
|
||||
|
||||
import Control.Monad.Logger (liftLoc, runLoggingT)
|
||||
import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr,
|
||||
pgPoolSize, runSqlPool)
|
||||
pgPoolSize, runSqlPool, runMigrationUnsafe)
|
||||
import Import
|
||||
import Language.Haskell.TH.Syntax (qLocation)
|
||||
import Network.Wai.Handler.Warp (Settings, defaultSettings,
|
||||
@ -32,6 +32,8 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
|
||||
-- Don't forget to add new modules to your cabal file!
|
||||
import Handler.Common
|
||||
import Handler.Home
|
||||
import Handler.Wallet
|
||||
import Handler.Register
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||
@ -67,7 +69,7 @@ makeFoundation appSettings = do
|
||||
(pgPoolSize $ appDatabaseConf appSettings)
|
||||
|
||||
-- Perform database migration using our application's logging settings.
|
||||
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
|
||||
runLoggingT (runSqlPool (runMigrationUnsafe migrateAll) pool) logFunc
|
||||
|
||||
-- Return the foundation
|
||||
return $ mkFoundation pool
|
||||
|
@ -121,7 +121,9 @@ instance YesodAuth App where
|
||||
-- Override the above two destinations when a Referer: header is present
|
||||
redirectToReferer _ = True
|
||||
|
||||
getAuthId creds = runDB $ do
|
||||
getAuthId creds = do
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ do
|
||||
x <- getBy $ UniqueUser $ credsIdent creds
|
||||
case x of
|
||||
Just (Entity uid _) -> return $ Just uid
|
||||
@ -129,6 +131,7 @@ instance YesodAuth App where
|
||||
fmap Just $ insert User
|
||||
{ userIdent = credsIdent creds
|
||||
, userPassword = Nothing
|
||||
, userLastLogin = now
|
||||
}
|
||||
|
||||
-- You can add other plugins like BrowserID, email or OAuth here
|
||||
|
@ -2,7 +2,8 @@ module Handler.Home where
|
||||
|
||||
import Import
|
||||
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
|
||||
withSmallInput)
|
||||
withSmallInput, withPlaceholder, bfs,
|
||||
withAutofocus)
|
||||
|
||||
-- This is a handler function for the GET request method on the HomeR
|
||||
-- resource pattern. All of your resource patterns are defined in
|
||||
@ -13,13 +14,27 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
|
||||
-- inclined, or create a single monolithic file.
|
||||
getHomeR :: Handler Html
|
||||
getHomeR = do
|
||||
(loginWidget, loginEnctype) <- generateFormPost loginForm
|
||||
defaultLayout $ do
|
||||
setTitle "NEAT"
|
||||
[whamlet|
|
||||
<h1>
|
||||
Welcome to NEAT.
|
||||
<div>
|
||||
Login
|
||||
<form method=post action=@{HomeR} enctype=#{loginEnctype}>
|
||||
^{loginWidget}
|
||||
<button>Submit
|
||||
<a href=@{RegisterR}>Register Account
|
||||
|]
|
||||
{-
|
||||
(formWidget, formEnctype) <- generateFormPost sampleForm
|
||||
let submission = Nothing :: Maybe (FileInfo, Text)
|
||||
handlerName = "getHomeR" :: Text
|
||||
defaultLayout $ do
|
||||
aDomId <- newIdent
|
||||
setTitle "Welcome To Yesod!"
|
||||
$(widgetFile "homepage")
|
||||
$(widgetFile "homepage")-}
|
||||
|
||||
postHomeR :: Handler Html
|
||||
postHomeR = do
|
||||
@ -38,3 +53,8 @@ sampleForm :: Form (FileInfo, Text)
|
||||
sampleForm = renderBootstrap3 BootstrapBasicForm $ (,)
|
||||
<$> fileAFormReq "Choose a file"
|
||||
<*> areq textField (withSmallInput "What's on the file?") Nothing
|
||||
|
||||
loginForm :: Form (Text, Text)
|
||||
loginForm = renderBootstrap3 BootstrapBasicForm $ (,)
|
||||
<$> areq textField ((withAutofocus . withPlaceholder "Username") (bfs ("Username" :: Text))) Nothing
|
||||
<*> areq passwordField (bfs ("Password" :: Text)) Nothing
|
||||
|
9
Handler/Register.hs
Normal file
9
Handler/Register.hs
Normal file
@ -0,0 +1,9 @@
|
||||
module Handler.Register where
|
||||
|
||||
import Import
|
||||
|
||||
getRegisterR :: Handler Html
|
||||
getRegisterR = error "Not yet implemented: getRegisterR"
|
||||
|
||||
postRegisterR :: Handler Html
|
||||
postRegisterR = error "Not yet implemented: postRegisterR"
|
6
Handler/Wallet.hs
Normal file
6
Handler/Wallet.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Handler.Wallet where
|
||||
|
||||
import Import
|
||||
|
||||
getWalletR :: Handler Html
|
||||
getWalletR = error "Not yet implemented: getWalletR"
|
@ -1,12 +1,64 @@
|
||||
User
|
||||
ident Text
|
||||
password Text Maybe
|
||||
lastLogin UTCTime default=now()
|
||||
UniqueUser ident
|
||||
deriving Typeable
|
||||
|
||||
Email
|
||||
email Text
|
||||
user UserId Maybe
|
||||
verkey Text Maybe
|
||||
UniqueEmail email
|
||||
|
||||
Api
|
||||
user User
|
||||
keyID Int64
|
||||
vCode Text
|
||||
|
||||
Character
|
||||
auth Api
|
||||
charID Int64
|
||||
brokerRelations Int default=0
|
||||
accounting Int default=0
|
||||
charName Text
|
||||
escrow Double default=0
|
||||
transaction_cu Int64 default=0
|
||||
standings_cu Int64 default=0
|
||||
balance_cu Int64 default=0
|
||||
escrow_cu Int64 default=0
|
||||
UniqueChar charID
|
||||
|
||||
FactionStandings
|
||||
char Character
|
||||
factionID Int64
|
||||
corpname Text
|
||||
standing Double
|
||||
|
||||
UserChars
|
||||
user User
|
||||
char Character
|
||||
|
||||
CharOrders
|
||||
char Character
|
||||
typeID Int64
|
||||
volRemaining Double
|
||||
range Int64
|
||||
orderID Int64
|
||||
volEntered Int64
|
||||
minVolume Int64
|
||||
isBuy Bool
|
||||
issueDate UTCTime
|
||||
duration Int64
|
||||
stationID Int64
|
||||
regionID Int64
|
||||
solarSystemID Int64
|
||||
escrow Double
|
||||
orderState Int64
|
||||
accountID Int64
|
||||
isCorp Bool
|
||||
|
||||
|
||||
|
||||
|
||||
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
|
||||
|
@ -5,3 +5,5 @@
|
||||
/robots.txt RobotsR GET
|
||||
|
||||
/ HomeR GET POST
|
||||
/wallet WalletR GET
|
||||
/register RegisterR GET POST
|
||||
|
@ -22,6 +22,8 @@ library
|
||||
Settings.StaticFiles
|
||||
Handler.Common
|
||||
Handler.Home
|
||||
Handler.Wallet
|
||||
Handler.Register
|
||||
|
||||
if flag(dev) || flag(library-only)
|
||||
cpp-options: -DDEVELOPMENT
|
||||
|
Loading…
Reference in New Issue
Block a user