From 4e3284c68204867e366e87a1c2dca075d3aeefb6 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Wed, 22 Jul 2015 02:01:58 +0200
Subject: [PATCH] little mishap with database. api keys should now behave.

---
 Handler/Settings.hs | 18 +++++++++---------
 Import.hs           |  6 +++---
 config/models       |  6 +-----
 3 files changed, 13 insertions(+), 17 deletions(-)

diff --git a/Handler/Settings.hs b/Handler/Settings.hs
index e377778..3b1b786 100644
--- a/Handler/Settings.hs
+++ b/Handler/Settings.hs
@@ -11,9 +11,9 @@ import qualified Data.Text.Lazy as T
 import qualified Data.ByteString.Lazy.Char8 as B
 
 getSettingsR :: Handler Html
-getSettingsR = loginOrDo $ (\u -> do
-               apiKey <- runDB $ getBy $ UniqueApiUser u
-               (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) u)
+getSettingsR = loginOrDo $ (\(uid,_) -> do
+               apiKey <- runDB $ getBy $ UniqueApiUser uid
+               (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
                man <- getHttpManager <$> ask
                validKey <- case apiKey of
                              Just (Entity _ key) -> liftIO $ checkApiKey key man
@@ -24,18 +24,18 @@ getSettingsR = loginOrDo $ (\u -> do
 
 
 postSettingsR :: Handler Html
-postSettingsR = loginOrDo $ (\u -> do
-                apiKey <- runDB $ getBy $ UniqueApiUser u
-                ((result,formWidget),formEnctype) <- runFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) u)
+postSettingsR = loginOrDo $ (\(uid,_) -> do
+                apiKey <- runDB $ getBy $ UniqueApiUser uid
+                ((result,formWidget),formEnctype) <- runFormPost $ renderBootstrap3 authFormLayout (authKeyForm (entityVal <$> apiKey) uid)
                 (success, msg) <- case result of
-                  FormSuccess api  -> do mapi <- runDB $ getBy $ UniqueApiUser u
+                  FormSuccess api  -> do mapi <- runDB $ getBy $ UniqueApiUser uid
                                          case mapi of
                                            Just (Entity aid _) -> runDB $ replace aid api
                                            Nothing -> runDB $ insert_ api
                                          return (True,[whamlet|Successful inserted Key|])
                   FormFailure errs -> return (False,[whamlet|Error:<br>#{concat $ intersperse "<br>" errs}|])
                   FormMissing      -> return (False,[whamlet|Error: No such Form|])
-                apiKey' <- runDB $ getBy $ UniqueApiUser u
+                apiKey' <- runDB $ getBy $ UniqueApiUser uid
                 man <- getHttpManager <$> ask
                 validKey <- case apiKey' of
                               Just (Entity _ key) -> liftIO $ checkApiKey key man
@@ -63,7 +63,7 @@ checkApiKey (Api _ key code) manager = do
           _ -> return False
   `catch` (\ (_ :: HttpException) -> return False)
 
-authKeyForm :: Maybe Api -> User -> AForm Handler Api
+authKeyForm :: Maybe Api -> Key User -> AForm Handler Api
 authKeyForm ma u = Api
              <$> pure u
              <*> areq intField (withPlaceholder "keyID" "keyID") (apiKeyID <$> ma)
diff --git a/Import.hs b/Import.hs
index d4c2c0b..ea0a6c8 100644
--- a/Import.hs
+++ b/Import.hs
@@ -6,12 +6,12 @@ import Foundation            as Import
 import Import.NoFoundation   as Import
 import Yesod.Form.Bootstrap3 as Import
 
-loginOrDo :: (User -> Handler Html) -> Handler Html
+loginOrDo :: ((Key User, User) -> Handler Html) -> Handler Html
 loginOrDo cont = do
                  maid <- maybeAuthId
                  muid <- case maid of
-                         Just uid -> runDB $ get uid
+                         Just uid -> fmap ((,) uid) <$> (runDB $ get uid)
                          Nothing -> return Nothing
                  case muid of
                       Nothing -> redirect (AuthR LoginR)
-                      Just u -> cont u
+                      Just (uid,u) -> cont (uid,u)
diff --git a/config/models b/config/models
index ca04acb..ca950da 100644
--- a/config/models
+++ b/config/models
@@ -16,7 +16,7 @@ Email
     UniqueEmail email
 
 Api
-    user User
+    user UserId
     keyID Int64
     vCode Text
     UniqueApiUser user
@@ -40,10 +40,6 @@ FactionStandings
     corpname Text
     standing Double
 
-UserChars
-    user User
-    char Character
-
 CharOrders
     char Character
     typeID Int64