add flag for mock auth and clean a little
This commit is contained in:
parent
e75dc37fe3
commit
d8b3c7feab
4 changed files with 22 additions and 2 deletions
|
@ -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
|
||||
|
|
|
@ -13,6 +13,7 @@ let
|
|||
pname = "mateamt";
|
||||
version = "0.0.0.0";
|
||||
src = ./.;
|
||||
configureFlags = [ "-fdevelop" ];
|
||||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
executableHaskellDepends = [
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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, _, _, _, _, _) ->
|
||||
|
|
Loading…
Reference in a new issue