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