Drezil/neat
1
0
Fork 0
Code Issues 5 Pull Requests Projects Releases Wiki Activity

little mishap with database. api keys should now behave.

Browse Source
This commit is contained in:
Nicole Dresselhaus 2015-07-22 02:01:58 +02:00
parent a707e64cce
commit 4e3284c682
3 changed files with 13 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Handler/Settings.hs
View File

@ -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)

6
Import.hs
View File

@ -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)

6
config/models
View File

@ -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