add flag for mock auth and clean a little

This commit is contained in:
nek0 2019-07-18 14:57:16 +02:00
parent e75dc37fe3
commit d8b3c7feab
4 changed files with 22 additions and 2 deletions

View File

@ -15,6 +15,11 @@ maintainer: nek0@nek0.eu
category: Web
extra-source-files: CHANGELOG.md
flag develop
description: compile mateamt in developer mode. Authentication disabled,
default: False
manual: True
executable mateamt
main-is: Main.hs
other-modules: API
@ -50,3 +55,5 @@ executable mateamt
, mtl
hs-source-dirs: src
default-language: Haskell2010
if flag(develop)
cpp-options: -DDEVELOP

View File

@ -13,6 +13,7 @@ let
pname = "mateamt";
version = "0.0.0.0";
src = ./.;
configureFlags = [ "-fdevelop" ];
isLibrary = false;
isExecutable = true;
executableHaskellDepends = [

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Model.Auth where
@ -213,9 +214,21 @@ processAuthRequest (AuthRequest aticket hash) = do
liftIO $ threadDelay $ 1 * 10 ^ 6
if now > ticketExpiry ticket
then
#if defined(DEVELOP)
do
mockticket <- Ticket <$> pure aticket <*> pure 1 <*> liftIO getCurrentTime
generateToken mockticket hash
#else
return Denied
#endif
else
generateToken ticket hash
_ -> do
liftIO $ threadDelay $ 1 * 10 ^ 6
#if defined(DEVELOP)
do
mockticket <- Ticket <$> pure aticket <*> pure 1 <*> liftIO getCurrentTime
generateToken mockticket hash
#else
return Denied
#endif

View File

@ -74,9 +74,8 @@ userTable = table "user" (
userSelect
:: PGS.Connection
-> Maybe Refine
-> Bool
-> MateHandler [User]
userSelect conn ref sw = do
userSelect conn ref = do
today <- utctDay <$> (liftIO $ getCurrentTime)
users <- liftIO $ runSelect conn (case ref of
Nothing -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->