aboutsummaryrefslogtreecommitdiff
path: root/server/src
diff options
context:
space:
mode:
authorJoris2018-01-03 17:31:20 +0100
committerJoris2018-01-03 17:31:22 +0100
commita4acc2e84158fa822f88a1d0bdddb470708b5809 (patch)
tree3faeb0128a51b437501470bd38be62e6e871e9f3 /server/src
parent49426740e8e0c59040f4f3721a658f225572582b (diff)
Modify weelky report and payment search interface
- Add payment balance in weekly report - Show a message and hide pages when the search results in no results - Go to page 1 when the search is updated / erased
Diffstat (limited to 'server/src')
-rw-r--r--server/src/Conf.hs4
-rw-r--r--server/src/Controller/Index.hs77
-rw-r--r--server/src/Controller/Payment.hs2
-rw-r--r--server/src/Controller/SignIn.hs44
-rw-r--r--server/src/Design/View/SignIn.hs2
-rw-r--r--server/src/Job/MonthlyPayment.hs2
-rw-r--r--server/src/Job/WeeklyReport.hs7
-rw-r--r--server/src/Main.hs81
-rw-r--r--server/src/Model/Income.hs12
-rw-r--r--server/src/Model/Init.hs2
-rw-r--r--server/src/Model/Mail.hs8
-rw-r--r--server/src/Model/Payment.hs41
-rw-r--r--server/src/SendMail.hs39
-rw-r--r--server/src/View/Mail/SignIn.hs2
-rw-r--r--server/src/View/Mail/WeeklyReport.hs32
-rw-r--r--server/src/View/Page.hs6
16 files changed, 176 insertions, 185 deletions
diff --git a/server/src/Conf.hs b/server/src/Conf.hs
index 2422a93..ca19c8d 100644
--- a/server/src/Conf.hs
+++ b/server/src/Conf.hs
@@ -17,6 +17,7 @@ data Conf = Conf
, currency :: Currency
, noReplyMail :: Text
, https :: Bool
+ , devMode :: Bool
} deriving Show
get :: FilePath -> IO Conf
@@ -30,7 +31,8 @@ get path = do
Conf.lookup "signInExpiration" conf <*>
fmap Currency (Conf.lookup "currency" conf) <*>
Conf.lookup "noReplyMail" conf <*>
- Conf.lookup "https" conf
+ Conf.lookup "https" conf <*>
+ Conf.lookup "devMode" conf
)
case conf of
Left msg -> error (T.unpack msg)
diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs
index f05ce6f..9a3e2b7 100644
--- a/server/src/Controller/Index.hs
+++ b/server/src/Controller/Index.hs
@@ -1,16 +1,23 @@
module Controller.Index
( get
+ , askSignIn
+ , trySignIn
, signOut
) where
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Lazy as TL
import Data.Time.Clock (diffUTCTime, getCurrentTime)
-import Network.HTTP.Types.Status (ok200)
+import Network.HTTP.Types.Status (badRequest400, ok200)
import Prelude hiding (error)
-import Web.Scotty hiding (get)
+import Web.Scotty (ActionM)
+import qualified Web.Scotty as S
-import Common.Model (InitResult (..), User (..))
+import Common.Model (InitResult (..), SignIn (..),
+ User (..))
import Common.Msg (Key)
import qualified Common.Msg as Msg
@@ -21,26 +28,52 @@ import qualified Model.Query as Query
import qualified Model.SignIn as SignIn
import qualified Model.User as User
import Secure (getUserFromToken)
+import qualified SendMail
+import qualified Text.Email.Validate as Email
+import qualified View.Mail.SignIn as SignIn
import View.Page (page)
-get :: Conf -> Maybe Text -> ActionM ()
-get conf mbToken = do
- initResult <- case mbToken of
- Just token -> do
- userOrError <- validateSignIn conf token
- case userOrError of
- Left errorKey ->
- return . InitEmpty . Left . Msg.get $ errorKey
- Right user ->
- liftIO . Query.run . fmap InitSuccess $ getInit user conf
- Nothing -> do
- mbLoggedUser <- getLoggedUser
- case mbLoggedUser of
- Nothing ->
- return . InitEmpty . Right $ Nothing
- Just user ->
- liftIO . Query.run . fmap InitSuccess $ getInit user conf
- html $ page initResult
+get :: Conf -> ActionM ()
+get conf = do
+ initResult <- do
+ mbLoggedUser <- getLoggedUser
+ case mbLoggedUser of
+ Nothing ->
+ return . InitEmpty . Right $ Nothing
+ Just user ->
+ liftIO . Query.run . fmap InitSuccess $ getInit user conf
+ S.html $ page initResult
+
+askSignIn :: Conf -> SignIn -> ActionM ()
+askSignIn conf (SignIn email) =
+ if Email.isValid (TE.encodeUtf8 email)
+ then do
+ maybeUser <- liftIO . Query.run $ User.get email
+ case maybeUser of
+ Just user -> do
+ token <- liftIO . Query.run $ SignIn.createSignInToken email
+ let url = T.concat [
+ if Conf.https conf then "https://" else "http://",
+ Conf.hostname conf,
+ "/signIn/",
+ token
+ ]
+ maybeSentMail <- liftIO . SendMail.sendMail conf $ SignIn.mail conf user url [email]
+ case maybeSentMail of
+ Right _ -> textKey ok200 Msg.SignIn_EmailSent
+ Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail
+ Nothing -> textKey badRequest400 Msg.Secure_Unauthorized
+ else textKey badRequest400 Msg.SignIn_EmailInvalid
+ where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key)
+
+trySignIn :: Conf -> Text -> ActionM ()
+trySignIn conf token = do
+ userOrError <- validateSignIn conf token
+ case userOrError of
+ Left errorKey ->
+ S.html $ page (InitEmpty . Left . Msg.get $ errorKey)
+ Right _ ->
+ S.redirect "/"
validateSignIn :: Conf -> Text -> ActionM (Either Key User)
validateSignIn conf textToken = do
@@ -82,4 +115,4 @@ getLoggedUser = do
liftIO . Query.run . getUserFromToken $ token
signOut :: Conf -> ActionM ()
-signOut conf = LoginSession.delete conf >> status ok200
+signOut conf = LoginSession.delete conf >> S.status ok200
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index c6c874a..f2af6c9 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -22,7 +22,7 @@ import qualified Secure
list :: ActionM ()
list =
Secure.loggedAction (\_ ->
- (liftIO . Query.run $ Payment.list) >>= json
+ (liftIO . Query.run $ Payment.listActive) >>= json
)
create :: CreatePayment -> ActionM ()
diff --git a/server/src/Controller/SignIn.hs b/server/src/Controller/SignIn.hs
deleted file mode 100644
index cf92c9f..0000000
--- a/server/src/Controller/SignIn.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-module Controller.SignIn
- ( signIn
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Data.Text.Lazy as TL
-import Network.HTTP.Types.Status (badRequest400, ok200)
-import Web.Scotty
-
-import Common.Model (SignIn (..))
-import qualified Common.Msg as Msg
-
-import Conf (Conf)
-import qualified Conf
-import qualified Model.Query as Query
-import qualified Model.SignIn as SignIn
-import qualified Model.User as User
-import qualified SendMail
-import qualified Text.Email.Validate as Email
-import qualified View.Mail.SignIn as SignIn
-
-signIn :: Conf -> SignIn -> ActionM ()
-signIn conf (SignIn email) =
- if Email.isValid (TE.encodeUtf8 email)
- then do
- maybeUser <- liftIO . Query.run $ User.get email
- case maybeUser of
- Just user -> do
- token <- liftIO . Query.run $ SignIn.createSignInToken email
- let url = T.concat [
- if Conf.https conf then "https://" else "http://",
- Conf.hostname conf,
- "?signInToken=",
- token
- ]
- maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email]
- case maybeSentMail of
- Right _ -> textKey ok200 Msg.SignIn_EmailSent
- Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail
- Nothing -> textKey badRequest400 Msg.Secure_Unauthorized
- else textKey badRequest400 Msg.SignIn_EmailInvalid
- where textKey st key = status st >> (text . TL.fromStrict $ Msg.get key)
diff --git a/server/src/Design/View/SignIn.hs b/server/src/Design/View/SignIn.hs
index 4d4be7b..7f5f503 100644
--- a/server/src/Design/View/SignIn.hs
+++ b/server/src/Design/View/SignIn.hs
@@ -23,7 +23,7 @@ design = do
width (pct 100)
marginBottom (px 10)
- button ? do
+ button # ".validate" ? do
Helper.button Color.gothic Color.white (px inputHeight) Constants.focusLighten
display flex
alignItems center
diff --git a/server/src/Job/MonthlyPayment.hs b/server/src/Job/MonthlyPayment.hs
index ca7e007..907be2b 100644
--- a/server/src/Job/MonthlyPayment.hs
+++ b/server/src/Job/MonthlyPayment.hs
@@ -12,7 +12,7 @@ import Util.Time (timeToDay)
monthlyPayment :: Maybe UTCTime -> IO UTCTime
monthlyPayment _ = do
- monthlyPayments <- Query.run Payment.listMonthly
+ monthlyPayments <- Query.run Payment.listActiveMonthlyOrderedByName
now <- getCurrentTime
actualDay <- timeToDay now
let punctualPayments = map
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 74180df..38d88b5 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -19,10 +19,7 @@ weeklyReport conf mbLastExecution = do
Nothing -> return ()
Just lastExecution -> do
(payments, incomes, users) <- Query.run $
- (,,) <$>
- Payment.modifiedDuring lastExecution now <*>
- Income.modifiedDuring lastExecution now <*>
- User.list
- _ <- SendMail.sendMail (WeeklyReport.mail conf users payments incomes lastExecution now)
+ (,,) <$> Payment.listPunctual <*> Income.list <*> User.list
+ _ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now)
return ()
return now
diff --git a/server/src/Main.hs b/server/src/Main.hs
index c8080dc..e298a06 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -1,83 +1,62 @@
-import Control.Applicative (liftA3)
-import Control.Monad.IO.Class (liftIO)
-
-import qualified Data.Text.Lazy as LT
import Network.Wai.Middleware.Gzip (GzipFiles (GzipCompress))
import qualified Network.Wai.Middleware.Gzip as W
import Network.Wai.Middleware.Static
-import Web.Scotty
-
-import Common.Model (Frequency (..), Payment (..))
-import qualified Common.Model as CM
+import qualified Web.Scotty as S
import qualified Conf
import qualified Controller.Category as Category
import qualified Controller.Income as Income
import qualified Controller.Index as Index
import qualified Controller.Payment as Payment
-import qualified Controller.SignIn as SignIn
-import qualified Data.Time as Time
import Job.Daemon (runDaemons)
-import qualified Model.Income as IncomeM
-import qualified Model.Payment as PaymentM
-import qualified Model.Query as Query
-import qualified Model.User as UserM
main :: IO ()
main = do
conf <- Conf.get "application.conf"
_ <- runDaemons conf
- scotty (Conf.port conf) $ do
- middleware $ W.gzip $ W.def { W.gzipFiles = GzipCompress }
- middleware . staticPolicy $ noDots >-> addBase "public"
+ S.scotty (Conf.port conf) $ do
+ S.middleware $ W.gzip $ W.def { W.gzipFiles = GzipCompress }
+ S.middleware . staticPolicy $ noDots >-> addBase "public"
- get "/exceedingPayer" $ do
- time <- liftIO Time.getCurrentTime
- (users, incomes, payments) <- liftIO . Query.run $
- liftA3 (,,) UserM.list IncomeM.list PaymentM.list
- let punctualPayments = filter ((==) Punctual . _payment_frequency) payments
- exceedingPayers = CM.getExceedingPayers time users incomes punctualPayments
- text . LT.pack . show $ exceedingPayers
+ S.get "/" $ do
+ Index.get conf
- get "/" $ do
- signInToken <- mbParam "signInToken"
- Index.get conf signInToken
+ S.post "/askSignIn" $ do
+ S.jsonData >>= Index.askSignIn conf
- post "/signIn" $ do
- jsonData >>= SignIn.signIn conf
+ S.get "/signIn/:signInToken" $ do
+ signInToken <- S.param "signInToken"
+ Index.trySignIn conf signInToken
- post "/signOut" $
+ S.post "/signOut" $
Index.signOut conf
- post "/payment" $
- jsonData >>= Payment.create
+ S.post "/payment" $
+ S.jsonData >>= Payment.create
- put "/payment" $
- jsonData >>= Payment.editOwn
+ S.put "/payment" $
+ S.jsonData >>= Payment.editOwn
- delete "/payment" $ do
- paymentId <- param "id"
+ S.delete "/payment" $ do
+ paymentId <- S.param "id"
Payment.deleteOwn paymentId
- post "/income" $
- jsonData >>= Income.create
+ S.post "/income" $
+ S.jsonData >>= Income.create
- put "/income" $
- jsonData >>= Income.editOwn
+ S.put "/income" $
+ S.jsonData >>= Income.editOwn
- delete "/income" $ do
- incomeId <- param "id"
+ S.delete "/income" $ do
+ incomeId <- S.param "id"
Income.deleteOwn incomeId
- post "/category" $
- jsonData >>= Category.create
+ S.post "/category" $
+ S.jsonData >>= Category.create
- put "/category" $
- jsonData >>= Category.edit
+ S.put "/category" $
+ S.jsonData >>= Category.edit
- delete "/category" $ do
- categoryId <- param "id"
+ S.delete "/category" $ do
+ categoryId <- S.param "id"
Category.delete categoryId
-
-mbParam :: Parsable a => LT.Text -> ActionM (Maybe a)
-mbParam key = (Just <$> param key) `rescue` (const . return $ Nothing)
diff --git a/server/src/Model/Income.hs b/server/src/Model/Income.hs
index a6174bc..4938e50 100644
--- a/server/src/Model/Income.hs
+++ b/server/src/Model/Income.hs
@@ -5,12 +5,11 @@ module Model.Income
, create
, editOwn
, deleteOwn
- , modifiedDuring
) where
import Data.Maybe (listToMaybe)
import Data.Time.Calendar (Day)
-import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (FromRow (fromRow), Only (Only))
import qualified Database.SQLite.Simple as SQLite
import Prelude hiding (id)
@@ -87,12 +86,3 @@ deleteOwn user incomeId =
Nothing ->
return False
)
-
-modifiedDuring :: UTCTime -> UTCTime -> Query [Income]
-modifiedDuring start end =
- Query (\conn ->
- SQLite.query
- conn
- "SELECT * FROM income WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
- (start, end, start, end, start, end)
- )
diff --git a/server/src/Model/Init.hs b/server/src/Model/Init.hs
index be44c72..0a0ffc7 100644
--- a/server/src/Model/Init.hs
+++ b/server/src/Model/Init.hs
@@ -18,7 +18,7 @@ getInit user conf =
Init <$>
User.list <*>
(return . _user_id $ user) <*>
- Payment.list <*>
+ Payment.listActive <*>
Income.list <*>
Category.list <*>
PaymentCategory.list <*>
diff --git a/server/src/Model/Mail.hs b/server/src/Model/Mail.hs
index a19f9ae..780efcc 100644
--- a/server/src/Model/Mail.hs
+++ b/server/src/Model/Mail.hs
@@ -5,8 +5,8 @@ module Model.Mail
import Data.Text (Text)
data Mail = Mail
- { from :: Text
- , to :: [Text]
- , subject :: Text
- , plainBody :: Text
+ { from :: Text
+ , to :: [Text]
+ , subject :: Text
+ , body :: Text
} deriving (Eq, Show)
diff --git a/server/src/Model/Payment.hs b/server/src/Model/Payment.hs
index 33551e5..5b29409 100644
--- a/server/src/Model/Payment.hs
+++ b/server/src/Model/Payment.hs
@@ -3,19 +3,18 @@
module Model.Payment
( Payment(..)
, find
- , list
- , listMonthly
+ , listActive
+ , listPunctual
+ , listActiveMonthlyOrderedByName
, create
, createMany
, editOwn
, deleteOwn
- , modifiedDuring
) where
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
-import Data.Time (UTCTime)
import Data.Time.Calendar (Day)
import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (FromRow (fromRow), Only (Only),
@@ -66,14 +65,22 @@ find paymentId =
SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
)
-list :: Query [Payment]
-list =
+listActive :: Query [Payment]
+listActive =
Query (\conn ->
SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
)
-listMonthly :: Query [Payment]
-listMonthly =
+listPunctual :: Query [Payment]
+listPunctual =
+ Query (\conn ->
+ SQLite.query
+ conn
+ (SQLite.Query "SELECT * FROM payment WHERE frequency = ?")
+ (Only Punctual))
+
+listActiveMonthlyOrderedByName :: Query [Payment]
+listActiveMonthlyOrderedByName =
Query (\conn ->
SQLite.query
conn
@@ -83,8 +90,7 @@ listMonthly =
, "WHERE deleted_at IS NULL AND frequency = ?"
, "ORDER BY name DESC"
])
- (Only Monthly)
- )
+ (Only Monthly))
create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
create userId paymentName paymentCost paymentDate paymentFrequency =
@@ -161,18 +167,3 @@ deleteOwn userId paymentId =
Nothing ->
return False
)
-
-modifiedDuring :: UTCTime -> UTCTime -> Query [Payment]
-modifiedDuring start end =
- Query (\conn ->
- SQLite.query
- conn
- (SQLite.Query $ T.intercalate " "
- [ "SELECT *"
- , "FROM payment"
- , "WHERE (created_at >= ? AND created_at <= ?)"
- , " OR (edited_at >= ? AND edited_at <= ?)"
- , " OR (deleted_at >= ? AND deleted_at <= ?)"
- ])
- (start, end, start, end, start, end)
- )
diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs
index c15ed62..3b17a0a 100644
--- a/server/src/SendMail.hs
+++ b/server/src/SendMail.hs
@@ -9,18 +9,41 @@ import qualified Network.Mail.Mime as M
import Data.Text (Text)
import qualified Data.Text as T
+import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder (fromText, toLazyText)
-import Model.Mail (Mail (Mail))
+import Conf (Conf)
+import qualified Conf
+import Model.Mail (Mail (..))
-sendMail :: Mail -> IO (Either Text ())
-sendMail mail = do
- result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
- if isLeft result
- then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result))
- else putStrLn "OK"
- return result
+sendMail :: Conf -> Mail -> IO (Either Text ())
+sendMail conf mail =
+ if Conf.devMode conf
+ then
+ do
+ T.putStrLn . mockMailMessage $ mail
+ return (Right ())
+ else
+ do
+ result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
+ if isLeft result
+ then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result))
+ else return ()
+ return result
+
+mockMailMessage :: Mail -> Text
+mockMailMessage mail = T.concat $
+ [ "[MOCK MAIL] "
+ , subject mail
+ , " (from: "
+ , from mail
+ , ") (to: "
+ , T.intercalate ", " $ to mail
+ , ")"
+ , "\n"
+ , body mail
+ ]
getMimeMail :: Mail -> M.Mail
getMimeMail (Mail mailFrom mailTo mailSubject mailPlainBody) =
diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs
index 22c3cb0..3c5469f 100644
--- a/server/src/View/Mail/SignIn.hs
+++ b/server/src/View/Mail/SignIn.hs
@@ -17,5 +17,5 @@ mail conf user url to =
{ M.from = Conf.noReplyMail conf
, M.to = to
, M.subject = Msg.get Msg.SignIn_MailTitle
- , M.plainBody = Msg.get (Msg.SignIn_MailBody (_user_name user) url)
+ , M.body = Msg.get (Msg.SignIn_MailBody (_user_name user) url)
}
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 4ad8b77..5418880 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -11,8 +11,8 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
-import Common.Model (Income (..), Payment (..), User (..),
- UserId)
+import Common.Model (ExceedingPayer (..), Income (..),
+ Payment (..), User (..), UserId)
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
@@ -35,11 +35,31 @@ mail conf users payments incomes start end =
, " − "
, Msg.get Msg.WeeklyReport_Title
]
- , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
+ , M.body = body conf users payments incomes start end
}
-body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
-body conf users paymentsByStatus incomesByStatus =
+body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
+body conf users payments incomes start end =
+ T.intercalate "\n" $
+ [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+ , operations conf users (groupByStatus start end payments) (groupByStatus start end incomes)
+ ]
+
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
+exceedingPayers conf time users incomes payments =
+ T.intercalate "\n" . map formatPayer $ payers
+ where
+ payers = CM.getExceedingPayers time users incomes payments
+ formatPayer p = T.concat
+ [ " * "
+ , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
+ , " + "
+ , Format.price (Conf.currency conf) $ _exceedingPayer_amount p
+ , "\n"
+ ]
+
+operations :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
+operations conf users paymentsByStatus incomesByStatus =
if M.null paymentsByStatus && M.null incomesByStatus
then
Msg.get Msg.WeeklyReport_Empty
@@ -96,5 +116,5 @@ section title items =
T.concat
[ title
, "\n\n"
- , T.unlines . map (" - " <>) $ items
+ , T.unlines . map (" * " <>) $ items
]
diff --git a/server/src/View/Page.hs b/server/src/View/Page.hs
index 27b4f26..97b84fa 100644
--- a/server/src/View/Page.hs
+++ b/server/src/View/Page.hs
@@ -26,10 +26,10 @@ page initResult =
meta ! charset "UTF-8"
meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
H.title (toHtml $ Msg.get Msg.App_Title)
- script ! src "javascript/main.js" $ ""
+ script ! src "/javascript/main.js" $ ""
jsonScript "init" initResult
- link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
- link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"
+ link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css"
+ link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png"
H.style $ toHtml globalDesign
jsonScript :: Json.ToJSON a => Text -> a -> Html