Add 0.0.0.7

Author: Jon Kristensen

src/Api.hs

@@ -9,11 +9,11 @@ module Api where
 import           Backend
 import           Control.Monad.Trans
 import           Control.Monad.Trans.Either
-import           Data.Traversable
-import qualified Data.Traversable as Traversable
 import           Data.Monoid
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           Data.Traversable
+import qualified Data.Traversable as Traversable
 import           Database.Persist.Sql
 import           Network.Wai
 import           Servant
@@ -26,6 +26,7 @@ type LoginAPI = "login"
               :> ReqBody '[JSON] Login
               :> Post '[JSON] (Headers '[Header "X-Token" B64Token] ReturnLogin)
 
+-- Will be transformed into X-Token header and token cookie by the nginx
 serveLogin :: ConnectionPool -> Config -> Server LoginAPI
 serveLogin pool conf loginReq = loginHandler
   where

src/Backend.hs

@@ -161,7 +161,8 @@ login Login{ loginUser = userEmail
                           Just p  -> do
                               createOTP twilioConf p userId
                               return $ Left LoginErrorOTPRequired
-                Just otp -> do
+                Just (Password otpC) -> do
+                    let otp = Password $ Text.toUpper otpC
                     otpTime <- fromIntegral . negate <$> getConfig oTPTimeoutSeconds
                     now <- liftIO getCurrentTime
                     let cutoff = otpTime `addUTCTime` now

src/Config.hs

@@ -1,5 +1,6 @@
 -- Copyright © 2015-2016 Nejla AB. All rights reserved.
 
+{-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -10,6 +11,7 @@ import           Control.Monad.Logger
 import           Control.Monad.Trans
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
+import           Data.Char
 import qualified Data.Configurator as Conf
 import qualified Data.Configurator.Types as Conf
 import           Data.Maybe (catMaybes)
@@ -96,6 +98,18 @@ getConf :: (MonadLogger m, MonadIO m) =>
             String -> Conf.Name -> Either Text Text -> Conf.Config -> m Text
 getConf = getConfGeneric (Just . Text.pack)
 
+getConfBool :: (MonadIO m, MonadLogger m) =>
+               String
+            -> Conf.Name
+            -> Either Text Bool
+            -> Conf.Config
+            -> m Bool
+getConfBool = getConfGeneric parseBool
+  where
+    parseBool str | (map toLower $ str) == "true" = Just True
+                  | (map toLower $ str) == "false" = Just False
+                  | otherwise = Nothing
+
 loadConf :: MonadIO m => m Conf.Config
 loadConf = liftIO $ do
     mbConfPath <- lookupEnv "CONF_PATH"
@@ -146,7 +160,7 @@ getTwilioConfig conf = do
             liftIO Exit.exitFailure
 
 get2FAConf conf = do
-     tfaRequired <- getConf' "TFA_REQUIRED" "tfa.required" (Right False) conf
+     tfaRequired <- getConfBool "TFA_REQUIRED" "tfa.required" (Right False) conf
      twilioConf <- getTwilioConfig conf
      case (tfaRequired, twilioConf) of
       (True, Nothing) -> do

web/nginx.conf.m4

@@ -64,7 +64,7 @@ http {
         location = /login {
                 proxy_pass http://AUTH_SERVICE/login/;
                 proxy_set_header X-Original-URI $request_uri;
-                add_header Set-Cookie "token=$upstream_http_x_token; Path=/";
+                add_header Set-Cookie "token=$upstream_http_x_token; Path=/; Expires=Fri, 01-Jan-2038 00:00:01 GMT";
         }
 
         location = /logout {