diff options
Diffstat (limited to 'src/server')
-rw-r--r-- | src/server/Conf.hs | 7 | ||||
-rw-r--r-- | src/server/Controller/SignIn.hs | 2 | ||||
-rw-r--r-- | src/server/Model/Message/Key.hs | 14 |
3 files changed, 10 insertions, 13 deletions
diff --git a/src/server/Conf.hs b/src/server/Conf.hs index 2269cf2..14da50f 100644 --- a/src/server/Conf.hs +++ b/src/server/Conf.hs @@ -7,14 +7,15 @@ module Conf import Data.Text (Text) import qualified Data.ConfigManager as Conf +import Data.Time.Clock (NominalDiffTime) data Conf = Conf { hostname :: Text , port :: Int - , signInExpirationMn :: Int + , signInExpiration :: NominalDiffTime , currency :: Text , noReplyMail :: Text - } deriving (Read, Eq, Show) + } deriving Show getConf :: FilePath -> IO (Either Text Conf) getConf path = @@ -23,7 +24,7 @@ getConf path = Conf <$> Conf.lookup "hostname" conf <*> Conf.lookup "port" conf <*> - Conf.lookup "signInExpirationMn" conf <*> + Conf.lookup "signInExpiration" conf <*> Conf.lookup "currency" conf <*> Conf.lookup "noReplyMail" conf ) diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs index 95cfd07..33c19b4 100644 --- a/src/server/Controller/SignIn.hs +++ b/src/server/Controller/SignIn.hs @@ -76,7 +76,7 @@ validateSignIn conf textToken = do return . Left $ SignInUsed else let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signInValue) - in if diffTime > (fromIntegral $ (signInExpirationMn conf) * 60) + in if diffTime > signInExpiration conf then return . Left $ SignInExpired else do diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index e9cbf99..6f29f43 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -4,9 +4,8 @@ module Model.Message.Key ( Key(..) ) where -import GHC.Generics - -import Data.Aeson +import qualified Data.Aeson as Json +import qualified Data.Text as T data Key = @@ -79,10 +78,7 @@ data Key = | NetworkError | UnexpectedPayload - deriving (Enum, Bounded, Show, Generic) - -instance ToJSON Key + deriving (Enum, Bounded, Show) --- instance ToJSON Coord where --- toJSON (Coord x y) = object ["x" .= x, "y" .= y] --- toEncoding (Coord x y) = pairs ("x" .= x <> "y" .= y) +instance Json.ToJSON Key where + toJSON = Json.String . T.pack . show |