serverSideValidation :: (Monad m, MonadIO m) => User -> m (Either (UserShaped (Const (Maybe Text))) User)
serverSideValidation u
  | correctInfo = do
      liftIO (threadDelay 1000000)
      return (Right u)
  | not userPresent = do
      liftIO (threadDelay 1000000)
      return . Left $ UserShaped (Const $ Just "The user mail is not present") (Const Nothing)
  | otherwise = do
      liftIO (threadDelay 1000000)
      return . Left $ UserShaped (Const Nothing) (Const $ Just "The password is wrong")
  where
    users = M.fromList [ ("user1@gmail.com", "pass1")
                       , ("user2@gmail.com", "pass2")
                       , ("user3@gmail.com", "pass3")
                       ]
    correctInfo = M.lookup (userMail u) users == Just (userPassword u)
    userPresent = userMail u `elem` M.keys users
serverSideValidation :: (Monad m, MonadIO m) => User -> m (Either (UserShaped (Const (Maybe Text))) User)
serverSideValidation u
  | correctInfo = do
      liftIO (threadDelay 1000000)
      return (Right u)
  | not userPresent = do
      liftIO (threadDelay 1000000)
      return . Left $ UserShaped (Const $ Just "The user mail is not present") (Const Nothing)
  | otherwise = do
      liftIO (threadDelay 1000000)
      return . Left $ UserShaped (Const Nothing) (Const $ Just "The password is wrong")
  where
    users = M.fromList [ ("user1@gmail.com", "pass1")
                       , ("user2@gmail.com", "pass2")
                       , ("user3@gmail.com", "pass3")
                       ]
    correctInfo = M.lookup (userMail u) users == Just (userPassword u)
    userPresent = userMail u `elem` M.keys users
serverSideValidation u
  | correctInfo = do
      liftIO (threadDelay 1000000)
      return (Right u)
  | not userPresent = do
      liftIO (threadDelay 1000000)
      return . Left $ UserShaped (Const $ Just "The user mail is not present") (Const Nothing)
  | otherwise = do
      liftIO (threadDelay 1000000)
      return . Left $ UserShaped (Const Nothing) (Const $ Just "The password is wrong")
  where
    users = M.fromList [ ("user1@gmail.com", "pass1")
                       , ("user2@gmail.com", "pass2")
                       , ("user3@gmail.com", "pass3")
                       ]
    correctInfo = M.lookup (userMail u) users == Just (userPassword u)
    userPresent = userMail u `elem` M.keys users