remove some warnings

This commit is contained in:
Filip Gralinski 2016-12-03 13:36:32 +01:00
parent 86d17e0c31
commit 5718401d50

View File

@ -1,17 +1,11 @@
module Handler.YourAccount where module Handler.YourAccount where
import Import import Import
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
withSmallInput, bfs)
import Handler.Shared
import Handler.Extract
import Text.Regex.TDFA import Text.Regex.TDFA
import Data.Conduit
import Data.Conduit.Binary import Data.Conduit.Binary
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -22,26 +16,20 @@ getYourAccountR = do
keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] [] keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] []
let key = publicKeyPubkey <$> entityVal <$> keyS let key = publicKeyPubkey <$> entityVal <$> keyS
(formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key) (formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key)
let submission = Nothing :: Maybe (Import.FileInfo, Text)
handlerName = "getYourAccountR" :: Text
defaultLayout $ do defaultLayout $ do
aDomId <- newIdent
setTitle "Your account" setTitle "Your account"
$(widgetFile "your-account") $(widgetFile "your-account")
postYourAccountR :: Handler Html postYourAccountR :: Handler Html
postYourAccountR = do postYourAccountR = do
((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing) ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing)
let handlerName = "postYourAccountR" :: Text let accountData = case result of
accountData = case result of
FormSuccess res -> Just res FormSuccess res -> Just res
_ -> Nothing _ -> Nothing
Just (name, localId, sshPubKey, avatarFile) = accountData Just (name, localId, sshPubKey, avatarFile) = accountData
userId <- requireAuthId userId <- requireAuthId
updateUserAccount userId name localId sshPubKey avatarFile updateUserAccount userId name localId sshPubKey avatarFile
user <- runDB $ get404 userId
defaultLayout $ do defaultLayout $ do
aDomId <- newIdent
setTitle "Your account" setTitle "Your account"
$(widgetFile "your-account") $(widgetFile "your-account")
@ -52,6 +40,7 @@ yourAccountForm maybeName maybeLocalId maybeSshPubKey = renderBootstrap3 Bootstr
<*> aopt textField (bfs MsgSshPubKey) (Just maybeSshPubKey) <*> aopt textField (bfs MsgSshPubKey) (Just maybeSshPubKey)
<*> fileAFormOpt (bfs MsgAvatar) <*> fileAFormOpt (bfs MsgAvatar)
localIdRegexp :: Regex
localIdRegexp = makeRegexOpts defaultCompOpt{newSyntax=True} defaultExecOpt ("\\`[a-z][-a-z0-9]{0,31}\\'" ::String) localIdRegexp = makeRegexOpts defaultCompOpt{newSyntax=True} defaultExecOpt ("\\`[a-z][-a-z0-9]{0,31}\\'" ::String)
unwantedLocalIds :: [Text] unwantedLocalIds :: [Text]
@ -98,7 +87,7 @@ updateLocalIdAndPubKey userId (Just localId) maybeSshPubKey = do
runDB $ deleteWhere [PublicKeyUser ==. userId] runDB $ deleteWhere [PublicKeyUser ==. userId]
case maybeSshPubKey of case maybeSshPubKey of
Just key -> do Just key -> do
runDB $ insert $ PublicKey { _ <- runDB $ insert $ PublicKey {
publicKeyUser=userId, publicKeyUser=userId,
publicKeyPubkey=key } publicKeyPubkey=key }
setMessage $ toHtml ("SSH public key added; now it may take 10 minutes for the keys to be active, please be patient" :: Text) setMessage $ toHtml ("SSH public key added; now it may take 10 minutes for the keys to be active, please be patient" :: Text)