Yesod: Passing the current user to a form - haskell

I've looked for this, but the answer found here ends up on a list containing the value. I'm wondering if there isn't another, more straightforward way to do what I need.
I have a form:
formReview :: UserId -> Form Review
formReview uid = renderDivs $ Review <$>
areq textField "Text" Nothing <*>
areq intField "Rating" Nothing <*>
areq (selectField films) "Film" Nothing <*>
pure uid
as you can see I'm trying to pass an user ID to the form, because these are the fields for Review:
Review
text Text
rating Int
film FilmId
author UserId
it requires the ID of the author.
The way I'm trying to do this is by doing the following on postReviewsR:
postReviewsR :: Handler Html
postReviewsR = do
uid <- lookupSession "_ID"
case uid of
Nothing -> do
defaultLayout [whamlet| <h1> User isn't logged in.|]
Just uid ->
((result, _), _) <- runFormPost $ formReview uid
case result of
FormSuccess review -> do
runDB $ insert review
defaultLayout [whamlet|
<h1> Review posted.
|]
_ -> redirect ReviewsR
it has to be a Maybe because in theory you could try to post something without being logged in, so uid could be empty. If I try to go straight to ((result, _), _) <- runFormPost $ formReview uid it says there's a Maybe Text.
Now my problem is similar the other post, it's this error:
• Couldn't match type ‘Text’ with ‘Key User’
Expected type: UserId
Actual type: Text
• In the first argument of ‘formReview’, namely ‘uid’
In the second argument of ‘($)’, namely ‘formReview uid’
In a stmt of a 'do' block:
((result, _), _) <- runFormPost $ formReview uid
and the suggestion in the linked post is to use keyToValues :: Key record -> [PersistValue] to turn the Key, which apparently is just Text, into what I need, the UserId.
It seems too clunky to me that I would need to do all this, then use head on that list to get the value within, all to get the ID into the form. There has to be another, more correct way, right? What am I missing here? How do I get the ID of the user who's making the Review in there?
EDIT: I should point out that I'm not using Yesod.Auth so I can't use its functions.

Assuming you're using a SQL backend, check out the persistent SQL documentation. You'll find the toSqlKey :: ToBackendKey SqlBackend record => Int64 -> Key record function. Basically, you'll need to parse your Text to Int64 and get a key using toSqlKey. You should probably also check if the key you're getting is actually valid.
(You've apparently misread the error, your uid is just a Text value, but you need a UserID which is a Key User).

Related

How do I process a parameterized Yesod form from a handler where the parameter is unavailable?

I have the following form:
userForm :: UserId -> Form UserDemographics
userForm uid = renderDivs $ UserDemographics <$>
pure uid <*>
areq yearField "Year of birth" Nothing <*>
areq textField "Gender" Nothing <*>
areq countryField "Country of residence" Nothing <*>
areq boolField "Are you a computer programmer?" Nothing
On my homepage, I use generateFormPost $ userForm (entityKey userEnt) to make a form with the UserId filled in. But I want to handle the input with AJAX, so a separate Handler gets the results of the form. The other handler doesn't have access to the UserId. How do I process the form? I tried this, which throws an error:
postDemoFormR :: Handler RepJson
postDemoFormR = do
((formData, _), _) <- runFormPost $ userForm undefined
$(logDebug) $ pack $ show formData
return $ repJson ()
I could change userForm's type to accept Maybe UserId instead of just UserId or make up a bogus UserId for the call to runFormPost but both of those are hacks. Is there an easy, clean way to do this?
You could use a hiddenField, but that's almost certainly not what you really want (any user would be able to spoof the UserId by just submitting a different value). Assuming what you're trying to do is actually say "who is the current user", you'd need some way of securely determining that in your AJAX handler (such as requireAuthId).

How get the user ID from the Session at (Yesod / Haskell Project

guys i got a little projet and i need to extrat de ID of the user from the Session.
I can't put it in a Text/Int because it says that the Session carry an Key (Sql Key i think) how can i converte it to Int to use in other methods from my project
I Tried to do it to recover the ID from session
getInicioR :: Handler Html
getInicioR = do
uid <- lookupSession "_ID"
user <- runDB $ get404 uid
Shows the follow error message:
Couldn't match expected type ‘Key t0’ with actual type ‘Maybe Text’
In the first argument of ‘get404’, namely ‘uid’
In the second argument of ‘($)’, namely ‘get404 uid’
Use keyToValues to get a list of PersistValue values.
keyToValues :: Key record -> [PersistValue]
If you know, for instance, that the key is a Text value, then your list will consist of a single PersistText value and you could proceed like this:
do uid <- lookupSession "_ID"
let pvals = keyToValues uid
[ PersistText txt ] = pvals
liftIO $ print pvals -- to see what pvals is
-- now txt is a Text value
...

Capturing Persistent Relations in a Form

I have defined a one-to-many relationship in Persistent but could not figure out how to create a form that can take one of the foreign keys as input. Simplifying my use case to something like this:
Person
name String
Car
personId PersonId
name Text
type Text
Now when I try to generate a Form for Car, what should be the field type for personId? I tried something like this but get an error:
entryForm :: Maybe Car -> Form Car
entryForm car = renderDivs $ Car
<$> areq personIdField "Person" Nothing
<*> areq textField "Car Name" ( carName <$> car)
<*> areq textField "Type" ( carType <$> car)
When I run the above I get the error: Not in scope: `personIdField'.
I tried intField and it says:
Couldn't match expected type `KeyBackend
persistent-1.2.1:Database.Persist.Sql.Types.SqlBackend Person'
with actual type `Text'
Expected type: Field
m0
(KeyBackend
persistent-1.2.1:Database.Persist.Sql.Types.SqlBackend Person)
Actual type: Field m0 Text
In the first argument of `areq', namely `intField'
In the second argument of `(<$>)', namely
`areq intField "Person" Nothing
Ideally I would like to populate a drop down of Person Names (if there are not too many) or have a free form text field (e.g., with autocomplete) when there are too many. Any suggestions on how I can get foreign key as an input from the user?
Update:
I tried using selectField as follows but not sure if I am doing this correctly. I still get an error. First I created a where statement to get personId:
where
personId = do
person <- runDB $ selectFirst [] [Asc PersonName]
case person of
Just (Entity pId p) -> return pId
-- Nothing -> ???
and then I changed my first areq to
<$> areq (selectField [("First", personId)]) "Person Name" Nothing
Thanks!
I was able to figure out how to use selectField properly. This is what I ended up doing:
where
people = do
entities <- runDB $ selectList [] [Asc PersonName]
optionsPairs $ map (\p -> (personName $ entityVal p, entityKey p)) entities
The form field became:
<$> areq (selectField people) "Person Name" Nothing
I still have not figured out free form entry just yet but this is a good start.

How is it used translated messages inside a Haskell file?

I have searched in internet, in the Yesod Web ebook and other tutorials (Yesod Tutorial) but I have not been able to clarify this problem. I am using the scaffolded site.
I have a handler, inside it returns a value, the email if the user is authenticated or a string if he is not. What I want is to return the localized message instead the string "(Unknown User ID)". My problem is to use a value from the message file (ex. MsgHello), if I do this, it returns errors like:
Couldn't match expected type AppMessage' with actual typeText'
I have tried using (show MsgHello) or (pack MsgHello), even calling msg <- getMessageRender but I have not been able to do what I expect. If you have any suggestions, they are welcome.
Thanks!!
PD: This is part of the code that I am working on, line :
getUserProfileR :: Handler RepHtml
getUserProfileR = do
maid <- maybeAuth
let user = case maid of
Nothing -> "(Unknown User ID)"
Just (Entity _ u) -> userEmail u
defaultLayout $ do
setTitleI MsgUserProfile
$(widgetFile "nhUserProfile")
Thanks to Tickhon Jelvis for pointing out those web pages, also I found this one: Poly Hamlet i18n where I was able to get the solution to the problem.
So, if I would like to use a localized message, I would do:
getUserProfileR :: Handler RepHtml
getUserProfileR = do
maid <- maybeAuth
msg <- getRenderMessage
let user = case maid of
Nothing -> msg MsgNoUser --"(Unknown User ID)"
Just (Entity _ u) -> userEmail u
defaultLayout $ do
setTitleI MsgUserProfile
$(widgetFile "nhUserProfile")
Also remember that there is a helper function "setTitleI" which takes directly a Msg value and avoids the use of "msg MsgThisPageTitle"
My understanding of the I18N module is that you want to take your AppMessage value and use renderMessage on it.
You need to pass in a type specifying your translation type and a list of languages as well as your message. The translation type is created using the mkMessage function and the list of languages looks something like ["en-US", "en-GB", "fr"].

selectOneMany Yesod Persistent

Im trying to get selectOneMany to work with limited success.
I have the following database models
User
email Text
verkey Text Maybe
verified Bool
password Text Maybe
UniqueUser email
date UTCTime
deriving Show
Competence
parent CompetenceId Maybe
title Text
UniqueCompetence title
deriving Show Read
UserCompetence
competence CompetenceId
user UserId Eq
UniqueUserCompetence user competence
deriving Show Read
code from my handler
mmember <- runMaybeT $ do
id <- MaybeT $ maybeAuth
user <- MaybeT . runDB . get . entityKey $ id
Entity memberId member <- MaybeT . runDB . getBy . UniqueMember . userEmail $ user
competences <- lift . runDB . runJoin $ (selectOneMany (UserCompetenceUser <-.) userCompetenceUser)
return (member,competences)
first of; I cant event get this code to run without adding a big type-signature, is this as it should be?
competences <- lift . runDB . runJoin $ (selectOneMany (UserCompetenceUser <-.) userCompetenceUser :: SelectOneMany SqlPersist (UserGeneric SqlPersist) (UserCompetenceGeneric SqlPersist))
secondly; what is the type of competences. Ideally i want to end up with [Entity competenceId competence].
Lastly; How would one add a filter to the above join so as to only acquire competences for 'user'?
I have already told you that it's not possible to avoid the extra type signature due to the fact that SelectOneMany uses type aliases that might not be inductive; i.e. your code tries to be more polymorphic than it should be, and the type signature is necessary to restrict that polymorphism.
You can avoid using the huge signature by constraining the types "from a different angle", e.g.:
return (member, competences :: [(Entity User, [Entity UserCompetence])])
Since the type aliases User and UserCompetence select a specific database backend, the types should be resolved appropriately.
Also, I just spoiled the type of competences for you. Hah! I hope that that's enough for you. If you want a many-to-many three-table join directly so that you can get all competences "owned" by an user, you should use prepared statements anyways because of the potential AST overhead, so check out the generic raw SQL interface which lets you do the traditional "SELECT * FROM foo WHERE bar = ?" [filteredBarValue] which you might be more used to working with; it doesn't offer the same type safety as the rest of persistent but I think that it's the easiest way to implement three-table joins in your case.
You can restrict the Users that are selected by modifying the result of oneFilterMany which has type OneFilterMany. Like so (haven't tested it, but should work):
let join = (selectOneMany (UserCompetenceUser <-.) userCompetenceUser)
{ somFilterOne = [... filters for User ...] }
competences <- lift . runDB . runJoin $ join
Thanks to (lots of) help from dflemstr I ended up with
mmember <- runMaybeT $ do
id <- MaybeT $ maybeAuth
let user = entityVal id
Entity memberId member <- MaybeT . runDB . getBy . UniqueMember . userEmail $ user
let competenceStatement =
Text.concat
[ "SELECT ?? "
, "FROM competence, user_competence "
, "WHERE competence.id = user_competence.competence_id "
, "AND ? = user_competence.user_id"
]
competences <- lift . runDB $ rawSql competenceStatement
[toPersistValue . entityKey $ id]
return (member, competences :: [Entity Competence])

Resources