First steps...

This commit is contained in:
Nicole Dresselhaus 2015-04-26 22:18:24 +02:00
parent d1808ad4d7
commit 7b18752be2
8 changed files with 101 additions and 5 deletions

View File

@ -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

View File

@ -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

View File

@ -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
View 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
View File

@ -0,0 +1,6 @@
module Handler.Wallet where
import Import
getWalletR :: Handler Html
getWalletR = error "Not yet implemented: getWalletR"

View File

@ -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)

View File

@ -5,3 +5,5 @@
/robots.txt RobotsR GET
/ HomeR GET POST
/wallet WalletR GET
/register RegisterR GET POST

View File

@ -22,6 +22,8 @@ library
Settings.StaticFiles
Handler.Common
Handler.Home
Handler.Wallet
Handler.Register
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT