added login-layout and changed default layout to different stuff. Also included Balance
This commit is contained in:
parent
ae16513293
commit
a71c8f3b26
@ -152,8 +152,10 @@ instance YesodAuth App where
|
|||||||
, userWalletTimeout = now
|
, userWalletTimeout = now
|
||||||
, userStandingsTimeout = now
|
, userStandingsTimeout = now
|
||||||
, userSkillTimeout = now
|
, userSkillTimeout = now
|
||||||
|
, userBalanceTimeout = now
|
||||||
, userAcc = 0
|
, userAcc = 0
|
||||||
, userBr = 0
|
, userBr = 0
|
||||||
|
, userBalanceCents = 0
|
||||||
}
|
}
|
||||||
Nothing -> return $ ServerError "Problems extracting Access-Token"
|
Nothing -> return $ ServerError "Problems extracting Access-Token"
|
||||||
where
|
where
|
||||||
|
@ -2,39 +2,40 @@ module Handler.Home where
|
|||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
-- This is a handler function for the GET request method on the HomeR
|
loginOrElse :: ((Key User, User) -> Handler Html) -> Handler Html -> Handler Html
|
||||||
-- resource pattern. All of your resource patterns are defined in
|
loginOrElse cont contElse = do
|
||||||
-- config/routes
|
maid <- maybeAuthId
|
||||||
--
|
muid <- case maid of
|
||||||
-- The majority of the code you will write in Yesod lives in these handler
|
Just uid -> fmap ((,) uid) <$> runDB (get uid)
|
||||||
-- functions. You can spread them across multiple files if you are so
|
Nothing -> return Nothing
|
||||||
-- inclined, or create a single monolithic file.
|
case muid of
|
||||||
|
Nothing -> contElse
|
||||||
|
Just (uid,u) -> cont (uid,u)
|
||||||
|
|
||||||
getHomeR :: Handler Html
|
getHomeR :: Handler Html
|
||||||
getHomeR = do
|
getHomeR = do
|
||||||
maid <- maybeAuthId
|
loginOrElse getLoggedIn getNotLoggedIn
|
||||||
muser <- case maid of
|
|
||||||
Just uid -> runDB $ get uid
|
|
||||||
Nothing -> return $ Nothing
|
getLoggedIn :: (Key User, User) -> Handler Html
|
||||||
|
getLoggedIn (uid, user) = do
|
||||||
|
loginLayout user $ [whamlet|
|
||||||
|
<h1>Welcome back, #{userName user}.
|
||||||
|
<p>Current Balance: #{prettyISK $ userBalanceCents user} ISK.
|
||||||
|
<p>Current Stock Worth: ...
|
||||||
|
<p>Current total Worth: ...
|
||||||
|
<p>Profit in the last 7 days: ...
|
||||||
|
|]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
getNotLoggedIn :: Handler Html
|
||||||
|
getNotLoggedIn = do
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "NEAT"
|
setTitle "NEAT"
|
||||||
[whamlet|
|
[whamlet|
|
||||||
<h1>
|
<h1>Welcome to NEAT.
|
||||||
$maybe u <- muser
|
<div>Here we should present features, images and other stuff to get people hooked.
|
||||||
Welcome back #{userName u}
|
|
||||||
$nothing
|
|
||||||
Welcome to NEAT.
|
|
||||||
<div>
|
|
||||||
$maybe u <- maid
|
|
||||||
<p>
|
|
||||||
Data: #{show u}<br>
|
|
||||||
<a href=@{AuthR LogoutR}>Logout
|
|
||||||
<br>
|
|
||||||
<a href=@{WalletR}>Wallet
|
|
||||||
<br>
|
|
||||||
<a href=@{SettingsR}>Settings
|
|
||||||
$nothing
|
|
||||||
<p>
|
|
||||||
<a href=@{AuthR LoginR}>Login
|
|
||||||
|]
|
|]
|
||||||
{-
|
{-
|
||||||
(formWidget, formEnctype) <- generateFormPost sampleForm
|
(formWidget, formEnctype) <- generateFormPost sampleForm
|
||||||
|
@ -11,7 +11,7 @@ import qualified Data.Text.Lazy as T
|
|||||||
import qualified Data.ByteString.Lazy.Char8 as B
|
import qualified Data.ByteString.Lazy.Char8 as B
|
||||||
|
|
||||||
getSettingsR :: Handler Html
|
getSettingsR :: Handler Html
|
||||||
getSettingsR = loginOrDo $ (\(uid,_) -> do
|
getSettingsR = loginOrDo $ (\(uid,user) -> do
|
||||||
apiKey <- runDB $ getBy $ UniqueApiUser uid
|
apiKey <- runDB $ getBy $ UniqueApiUser uid
|
||||||
(formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
|
(formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
|
||||||
man <- getHttpManager <$> ask
|
man <- getHttpManager <$> ask
|
||||||
@ -19,12 +19,12 @@ getSettingsR = loginOrDo $ (\(uid,_) -> do
|
|||||||
Just (Entity _ key) -> liftIO $ checkApiKey key man
|
Just (Entity _ key) -> liftIO $ checkApiKey key man
|
||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
insertionWidget <- return Nothing :: Handler (Maybe Widget)
|
insertionWidget <- return Nothing :: Handler (Maybe Widget)
|
||||||
defaultLayout $(widgetFile "settings")
|
loginLayout user $(widgetFile "settings")
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
postSettingsR :: Handler Html
|
postSettingsR :: Handler Html
|
||||||
postSettingsR = loginOrDo $ (\(uid,_) -> do
|
postSettingsR = loginOrDo $ (\(uid,user) -> do
|
||||||
apiKey <- runDB $ getBy $ UniqueApiUser uid
|
apiKey <- runDB $ getBy $ UniqueApiUser uid
|
||||||
((result,formWidget),formEnctype) <- runFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
|
((result,formWidget),formEnctype) <- runFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
|
||||||
(success, msg) <- case result of
|
(success, msg) <- case result of
|
||||||
@ -46,7 +46,7 @@ $if success
|
|||||||
$else
|
$else
|
||||||
<div class="alert alert-danger" role="alert">^{msg}
|
<div class="alert alert-danger" role="alert">^{msg}
|
||||||
|] :: Handler (Maybe Widget)
|
|] :: Handler (Maybe Widget)
|
||||||
defaultLayout $(widgetFile "settings")
|
loginLayout user $(widgetFile "settings")
|
||||||
)
|
)
|
||||||
|
|
||||||
checkApiKey :: Api -> Manager -> IO Bool
|
checkApiKey :: Api -> Manager -> IO Bool
|
||||||
|
@ -81,7 +81,7 @@ getStockR = loginOrDo (\(uid,user) -> do
|
|||||||
order by t.type_name asc"
|
order by t.type_name asc"
|
||||||
(items :: [Stock]) <- runDB $ rawSql sql [toPersistValue uid]
|
(items :: [Stock]) <- runDB $ rawSql sql [toPersistValue uid]
|
||||||
let items' = convertStock <$> items
|
let items' = convertStock <$> items
|
||||||
defaultLayout $ [whamlet|
|
loginLayout user $ [whamlet|
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>Current Stock:
|
<div .panel-heading>Current Stock:
|
||||||
<table .table .table-condensed .small .table-bordered>
|
<table .table .table-condensed .small .table-bordered>
|
||||||
|
@ -7,8 +7,10 @@ import qualified Eve.Api.Char.WalletTransactions as WT
|
|||||||
import qualified Eve.Api.Types as T
|
import qualified Eve.Api.Types as T
|
||||||
import qualified Eve.Api.Char.Standings as ST
|
import qualified Eve.Api.Char.Standings as ST
|
||||||
import qualified Eve.Api.Char.Skills as SK
|
import qualified Eve.Api.Char.Skills as SK
|
||||||
|
import qualified Eve.Api.Char.AccountBalance as BA
|
||||||
import Database.Persist.Sql
|
import Database.Persist.Sql
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
|
import Control.Lens.Operators
|
||||||
|
|
||||||
accountingId :: Int64
|
accountingId :: Int64
|
||||||
accountingId = 16622
|
accountingId = 16622
|
||||||
@ -80,6 +82,15 @@ getUpdateR = loginOrDo (\(uid,user) -> do
|
|||||||
mapM_ (\(Entity eid t) -> replace eid t) trans
|
mapM_ (\(Entity eid t) -> replace eid t) trans
|
||||||
let updateProblemSql = "update transaction t set problematic=true where t.trans_is_sell and t.in_stock < 0"
|
let updateProblemSql = "update transaction t set problematic=true where t.trans_is_sell and t.in_stock < 0"
|
||||||
runDB $ rawExecute updateProblemSql []
|
runDB $ rawExecute updateProblemSql []
|
||||||
|
--update Balance
|
||||||
|
when (userBalanceTimeout user < now) $
|
||||||
|
do
|
||||||
|
balance <- liftIO $ BA.getAccountBalance man apidata
|
||||||
|
case balance of
|
||||||
|
T.QueryResult time' balance' -> runDB $ do
|
||||||
|
update uid [UserBalanceCents =. fromIntegral (balance' ^. BA.centbalance)]
|
||||||
|
update uid [UserBalanceTimeout =. time']
|
||||||
|
_ -> return ()
|
||||||
redirect WalletR
|
redirect WalletR
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -61,7 +61,7 @@ getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
|
|||||||
order by \
|
order by \
|
||||||
extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) asc"
|
extract(day from (now() at time zone 'utc')-date(date_time at time zone 'utc')) asc"
|
||||||
(profits :: [Profit]) <- runDB $ rawSql profitquery [toPersistValue uid, toPersistValue days]
|
(profits :: [Profit]) <- runDB $ rawSql profitquery [toPersistValue uid, toPersistValue days]
|
||||||
defaultLayout $ [whamlet|
|
loginLayout user $ [whamlet|
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>Transactions in the last #{hrs} hours:
|
<div .panel-heading>Transactions in the last #{hrs} hours:
|
||||||
<div .btn-group .btn-group-justified role="group">
|
<div .btn-group .btn-group-justified role="group">
|
||||||
|
24
Import.hs
24
Import.hs
@ -7,6 +7,7 @@ import Import.NoFoundation as Import
|
|||||||
import Yesod.Form.Bootstrap3 as Import
|
import Yesod.Form.Bootstrap3 as Import
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Data.List (unfoldr)
|
import Data.List (unfoldr)
|
||||||
|
import Text.Hamlet
|
||||||
|
|
||||||
loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html
|
loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html
|
||||||
loginOrDo cont = do
|
loginOrDo cont = do
|
||||||
@ -37,3 +38,26 @@ showTime t = printf "%02u" hours ++ ":" ++ printf "%02u" minutes ++ ":" ++ print
|
|||||||
showDateTime :: UTCTime -> String
|
showDateTime :: UTCTime -> String
|
||||||
showDateTime t = (show . utctDay $ t) ++ " " ++
|
showDateTime t = (show . utctDay $ t) ++ " " ++
|
||||||
(showTime . round . utctDayTime $ t)
|
(showTime . round . utctDayTime $ t)
|
||||||
|
|
||||||
|
loginLayout :: ToWidget App a =>
|
||||||
|
User
|
||||||
|
-> a
|
||||||
|
-> HandlerT
|
||||||
|
App IO Html
|
||||||
|
loginLayout user widget = do
|
||||||
|
master <- getYesod
|
||||||
|
mmsg <- getMessage
|
||||||
|
|
||||||
|
-- We break up the default layout into two components:
|
||||||
|
-- default-layout is the contents of the body tag, and
|
||||||
|
-- default-layout-wrapper is the entire page. Since the final
|
||||||
|
-- value passed to hamletToRepHtml cannot be a widget, this allows
|
||||||
|
-- you to use normal widget features in default-layout.
|
||||||
|
|
||||||
|
pc <- widgetToPageContent $ do
|
||||||
|
addStylesheet $ StaticR css_bootstrap_css
|
||||||
|
addStylesheet $ StaticR css_neat_css
|
||||||
|
addScript $ StaticR js_jquery_js
|
||||||
|
addScript $ StaticR js_bootstrap_js
|
||||||
|
$(widgetFile "default-layout")
|
||||||
|
withUrlRenderer $(hamletFile "templates/login-layout-wrapper.hamlet")
|
||||||
|
@ -8,9 +8,11 @@ User
|
|||||||
accessToken Text
|
accessToken Text
|
||||||
walletTimeout UTCTime
|
walletTimeout UTCTime
|
||||||
standingsTimeout UTCTime
|
standingsTimeout UTCTime
|
||||||
|
balanceTimeout UTCTime
|
||||||
skillTimeout UTCTime
|
skillTimeout UTCTime
|
||||||
br Int -- Broker-Relations-Skill
|
br Int -- Broker-Relations-Skill
|
||||||
acc Int -- Accounting-Skill
|
acc Int -- Accounting-Skill
|
||||||
|
balanceCents Int64
|
||||||
UniqueUser ident
|
UniqueUser ident
|
||||||
deriving Typeable
|
deriving Typeable
|
||||||
|
|
||||||
|
@ -25,6 +25,6 @@ database:
|
|||||||
database: "_env:PGDATABASE:neat"
|
database: "_env:PGDATABASE:neat"
|
||||||
poolsize: "_env:PGPOOLSIZE:10"
|
poolsize: "_env:PGPOOLSIZE:10"
|
||||||
|
|
||||||
copyright: For all services on this Page a FULL API-Key is required! This page is run by an individual person, who is not affiliated with CCP in any way (other than he plays EVE). The service is currently in development and may break at any time. There is no backup-service and the data you enter may be lost when the servers harddrive crashes. CCP can not be held responsible for any malfunction of this page.
|
copyright: For all services on this Page an API-Key with access to Wallet, Transaction and more is required! This page is run by an individual person, who is not affiliated with CCP in any way (other than he plays EVE). The service is currently in development and may break at any time. There is no backup-service and the data you enter may be lost when the servers harddrive crashes. CCP can not be held responsible for any malfunction of this page.
|
||||||
This page may improve your trading-ability, but we can't be made responsible for anything. Your PC may malfunction, explode or a llama may appear in your room - don't sue us for that.
|
This page may improve your trading-ability, but we can't be made responsible for anything. Your PC may malfunction, explode or a llama may appear in your room - don't sue us for that.
|
||||||
#analytics: UA-YOURCODE
|
#analytics: UA-YOURCODE
|
||||||
|
@ -91,6 +91,7 @@ library
|
|||||||
, xml-lens
|
, xml-lens
|
||||||
, xml-conduit
|
, xml-conduit
|
||||||
, eve-api
|
, eve-api
|
||||||
|
, lens
|
||||||
|
|
||||||
|
|
||||||
executable neat
|
executable neat
|
||||||
|
@ -40,9 +40,7 @@ $newline never
|
|||||||
<div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1">
|
<div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1">
|
||||||
<ul class="nav navbar-nav">
|
<ul class="nav navbar-nav">
|
||||||
<li><a href="@{HomeR}">Home</a>
|
<li><a href="@{HomeR}">Home</a>
|
||||||
<li><a href="@{WalletR}">Transactions</a>
|
<li><a href="#">Features</a>
|
||||||
<li><a href="@{StockR}">Stock</a>
|
|
||||||
<li><a href="@{SettingsR}">Settings</a>
|
|
||||||
<!--li class="dropdown">
|
<!--li class="dropdown">
|
||||||
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
|
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
|
||||||
<ul class="dropdown-menu">
|
<ul class="dropdown-menu">
|
||||||
@ -54,8 +52,8 @@ $newline never
|
|||||||
<li role="separator" class="divider">
|
<li role="separator" class="divider">
|
||||||
<li><a href="@SettingsR">Settings</a-->
|
<li><a href="@SettingsR">Settings</a-->
|
||||||
<ul class="nav navbar-nav navbar-right">
|
<ul class="nav navbar-nav navbar-right">
|
||||||
<li><a href="@{UpdateR}">Update</a>
|
<li><a href="@{AuthR LoginR}">Login (for now)</a>
|
||||||
<li><a href="@{AuthR LogoutR}">Logout</a>
|
<li><a href="#">Fancy "Login with Eve"</a>
|
||||||
<div id="main" role="main">
|
<div id="main" role="main">
|
||||||
^{pageBody pc}
|
^{pageBody pc}
|
||||||
<footer class="footer">
|
<footer class="footer">
|
||||||
|
75
templates/login-layout-wrapper.hamlet
Normal file
75
templates/login-layout-wrapper.hamlet
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
$newline never
|
||||||
|
\<!doctype html>
|
||||||
|
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
|
||||||
|
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
|
||||||
|
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
|
||||||
|
\<!--[if gt IE 8]><!-->
|
||||||
|
<html class="no-js" lang="en"> <!--<![endif]-->
|
||||||
|
<head>
|
||||||
|
<meta charset="UTF-8">
|
||||||
|
|
||||||
|
<title>#{pageTitle pc}
|
||||||
|
<meta name="description" content="">
|
||||||
|
<meta name="author" content="">
|
||||||
|
|
||||||
|
<meta name="viewport" content="width=device-width,initial-scale=1">
|
||||||
|
|
||||||
|
^{pageHead pc}
|
||||||
|
|
||||||
|
\<!--[if lt IE 9]>
|
||||||
|
\<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
|
||||||
|
\<![endif]-->
|
||||||
|
|
||||||
|
<script>
|
||||||
|
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
|
||||||
|
<body>
|
||||||
|
<div class="container">
|
||||||
|
<header>
|
||||||
|
<nav class="navbar navbar-default navbar-fixed-top">
|
||||||
|
<div class="container-fluid">
|
||||||
|
<!-- Brand and toggle get grouped for better mobile display -->
|
||||||
|
<div class="navbar-header">
|
||||||
|
<button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#bs-example-navbar-collapse-1" aria-expanded="false">
|
||||||
|
<span class="sr-only">Toggle navigation
|
||||||
|
<span class="icon-bar">
|
||||||
|
<span class="icon-bar">
|
||||||
|
<span class="icon-bar">
|
||||||
|
<a class="navbar-brand" href="@{HomeR}">NEAT
|
||||||
|
|
||||||
|
<!-- Collect the nav links, forms, and other content for toggling -->
|
||||||
|
<div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1">
|
||||||
|
<ul class="nav navbar-nav">
|
||||||
|
<li><a href="@{HomeR}">Home</a>
|
||||||
|
<li><a href="@{WalletR}">Transactions</a>
|
||||||
|
<li><a href="@{StockR}">Stock</a>
|
||||||
|
<li><a href="@{SettingsR}">Settings</a>
|
||||||
|
<li><a href="#">#{prettyISK $ userBalanceCents user} ISK</a>
|
||||||
|
<!--li class="dropdown">
|
||||||
|
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-haspopup="true" aria-expanded="false">Dropdown <span class="caret"></span>
|
||||||
|
<ul class="dropdown-menu">
|
||||||
|
<li><a href="#">Action</a>
|
||||||
|
<li><a href="#">Another action</a>
|
||||||
|
<li><a href="#">Something else here</a>
|
||||||
|
<li role="separator" class="divider">
|
||||||
|
<li><a href="#">Separated link</a>
|
||||||
|
<li role="separator" class="divider">
|
||||||
|
<li><a href="@SettingsR">Settings</a-->
|
||||||
|
<ul class="nav navbar-nav navbar-right">
|
||||||
|
<li><a href="@{UpdateR}">Update</a>
|
||||||
|
<li><a href="@{AuthR LogoutR}">Logout</a>
|
||||||
|
<div id="main" role="main">
|
||||||
|
^{pageBody pc}
|
||||||
|
<footer class="footer">
|
||||||
|
<div class="container">
|
||||||
|
#{appCopyright $ appSettings master}
|
||||||
|
|
||||||
|
$maybe analytics <- appAnalytics $ appSettings master
|
||||||
|
<script>
|
||||||
|
if(!window.location.href.match(/localhost/)){
|
||||||
|
window._gaq = [['_setAccount','#{analytics}'],['_trackPageview'],['_trackPageLoadTime']];
|
||||||
|
(function() {
|
||||||
|
\ var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
|
||||||
|
\ ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
|
||||||
|
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
|
||||||
|
})();
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user