Implement Login via JSON endpoint

Add additional handling of JSON endpoint in addition to the HTML form
method.

yesod-auth/Yesod/Auth/Email.hs

@@ -512,11 +512,28 @@ $newline never
 |]
 
 
+parseCreds :: Value -> Parser (Text, Text)
+parseCreds = withObject "creds" (\obj -> do
+                                   email' <- obj .: "email"
+                                   pass <- obj .: "password"
+                                   return (email', pass))
+
+
 postLoginR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) TypedContent
 postLoginR = do
-    (identifier, pass) <- lift $ runInputPost $ (,)
+    result <- lift $ runInputPostResult $ (,)
         <$> ireq textField "email"
         <*> ireq textField "password"
+    (creds :: Result Value) <- lift parseJsonBody
+    let midentifier = case result of
+                        FormSuccess (iden, pass) -> Just (iden, pass)
+                        _ -> case creds of
+                               Error _ -> Nothing
+                               Success val -> parseMaybe parseCreds val
+                                              
+    case midentifier of
+      Nothing -> loginErrorMessageI LoginR Msg.NoIdentifierProvided
+      Just (identifier, pass) -> do
           mecreds <- lift $ getEmailCreds identifier
           maid <-
               case ( mecreds >>= emailCredsAuthId
@@ -527,8 +544,7 @@ postLoginR = do
                        mrealpass <- lift $ getPassword aid
                        case mrealpass of
                          Nothing -> return Nothing
-                    Just realpass -> return $
+                         Just realpass -> return $ if isValidPass pass realpass
-                        if isValidPass pass realpass
                                                    then Just email
                                                    else Nothing
                 _ -> return Nothing