timeout function in Yesod - haskell

I have a Yesod app, with a table in my database with a flag with three posible states (ToUse, Using, Used), bu default ToUse.
when a user click a button the flag in database change to Using, the idea is that after 10 minutes if the flag was not change to Used (operation that make another user with another button) the flag go back to ToUSe, the problem is that searching i can't find a method to delay the operation to edit my database and I'm not sure if it is possible in Yesod
Searching I find timeout library but if I understand right that library only stop the execution of a program don't delay his start
I try to use Control.Concurrent but, get the following error
testTimeOut = do
c1 <- atomically $ newTQueue
C.forkIO $ do
C.threadDelay (2 * 1000000)
id <- runDB $ insert $ SubForm "ToUse" 10
atomically $ do
writeTQueue c1 "result 1"
Couldn't match expected type ‘IO t0’
with actual type ‘HandlerT site0 IO (Key SubForm)’
EDIT
This code work form me
getFooR :: Handler RepHtml
getFooR = do
runInnerHandler <- handlerToIO
liftIO $ forkIO $ runInnerHandler $ do
Code here runs inside GHandler but on a new thread.
This is the inner GHandler.
...
Code here runs inside the request's control flow.
This is the outer GHandler.
...

I assume you are looking for forkHandler.

Related

How to deal with incomplete JSON/Record types (IE missing required fields which I'll later fill in)?

EDIT: For those with similar ailments, I found this is related to the "Extensible Records Problem", something I will personally research more into.
EDIT2: I have started to solve this (weeks later now) by being pretty explicit about data types, and having multiple data types per semantic unit of data. For example, if the database holds an X, my code has an XAction for representing things I want to do with an X, and XResponse for relaying Xs to an http client. And then I need to build the supporting code for shuttling bits between instances. Not ideal, but, I like that it's explicit, and hopefully when my models crystallize, it shouldn't really need much up keep, and should be very reliable.
I'm not sure what the correct level of abstraction is for tackling this problem (ie records? or Yesod?) So I'll just lay out the simple case.
Simple Case / TL;DR
I want to decode a request body into a type
data Comment = Comment {userid :: ..., comment :: ...}
but actually I don't want the request body to contain userid, the server will supply that based on their Auth Headers, (or wherever I want to get data to default fill a field).
So they actually pass me something like:
data SimpleComment = SimpleComment {comment :: ...} deriving (Generic, FromJSON)
And I turn it into a Comment. But maintaining both nearly-identical types simultaneously is a hassle, and not DRY.
How do I solve this problem?
Details on Problem
I have a record type:
data Comment = Comment {userid :: ..., comment :: ...}
I have a POST route:
postCommentR :: Handler Value
postCommentR = do
c <- requireJsonBody :: (Handler Comment)
insertedComment <- runDB ...
returnJson insertedComment
Notice that the Route requires that the user supply their userid (in the Comment type, which is at least redundant since their id is associated with their auth headers. At worst, it means I need to check that users are adding their own id, or throwing away their supplied id, in which case why did they supply it in the first case.
So, I want a record type that's Comment minus userid, but I don't know how to do that intelligently.
My Current (awful but working) Solution
So I made a custom type with derived FromJSON (for the request body) which is almost completely redundant with the Comment type.
data SimpleComment = SimpleComment {comment :: ...} deriving (Generic, FromJSON)
Then my new route needs to decode the request body according to this, and then merge a SimpleComment with a userid field to make it a Comment:
postComment2R :: Handler Value
postComment2R = do
c <- requireJsonBody :: (Handler SimpleComment)
(uid, _) requireAuthPair
insertedComment <- runDB $ insertEntity (Comment { commentUserid = uid
, commentComment = comment c})
returnJson ...
Talk about boilerplate. And my use case is more complex than this simple Comment type.
If it factors in, you might be able to tell, I'm using the Yesod Scaffolding.
What I usually do to get a type minus a field is just to have a function which take that field and return the type. In your case you just need to declare an JSON instance for UserId -> Comment. Ok it doesn't seem natural and you have to go it manually but it actually works really well, especially as there is only one field of type UserId in Comment.
A solution I like is to use a wrapper for things that come from/go to the DB:
data Authenticated a = Authenticated
{ uid :: Uid
, thing :: a
} deriving (Show)
Then you can have Comment be just SimpleComment and turn it into an Authenticated Comment once you know the user id.
I'm also looking for a nice way to solve this. :-)
What I usually do in my code is to operate directly on the Aeson's type Value. This is some of the sample code taken from my current project:
import qualified Data.HashMap.Strict as HM
removeKey :: Text -> Value -> Value
removeKey key (Object xs) = Object $ HM.delete key xs
removeKey _ ys = ys
I directly operate on the value Object and remove the particular key present in the javascript object.
And in the Yesod handler code, I do this processing:
myHandler :: Handler RepJson
myHandler = do
userId <- insert $ User "sibi" 23
guser <- getJuser user
let guser' = removeKey "someId" $ toJSON guser
return $ repJson $ object [ "details" .= guser' ]
In some cases, I actually want to add some specific key to the outgoing JSON object. For those, I have specific helper functions defined which operate on the type Value. While this is not perfect, it has been helping me to avoid a lot of boilerplate code.

Using Yesod.Auth.Hardcoded SiteAdmin in a hamlet template

Problem description
I've been unable to get a compiling example of using Yesod.Auth.Hardcoded. My problem is in trying to interrogate the user in a hamlet template. My Foundation.hs is set up as per the documentation in the link for hardcoded. My handler looks like this:
getHomeR :: Handler Html
getHomeR = do
uid <- maybeAuthId
(widget, enctype) <- generateFormPost . renderBootstrap3 BootstrapBasicForm $ blurbForm Nothing
currentPost <- runDB $ selectFirst [] [Desc BlogId]
currentBlurb <- runDB $ selectFirst [] [Desc BlurbId]
defaultLayout $ do
setTitle "My site"
addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.11.2/jquery.min.js"
addScriptRemote "https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.2.0/js/collapse.js"
$(widgetFile "homepage")
My site compiles and renders happily until I try to do anything useful with the uid being assigned in the do block above.
What I've tried
I've tried both the $maybe and $case constructs in the hamlet documentation. $maybe looked like this:
$maybe user <- uid
<p>There's a name
$nothing
<p>No name
This succeeded regardless of whether I logged in as the hardcoded user.
The $case version looked like this:
$case uid
$of Left _
<p>There's no name
$of Right username
<p>It worked
and failed with:
Exception when trying to run compile-time code:
Inside a $case there may only be $of. Use '$of _' for a wildcard.
Code: widgetFile "homepage"
In the splice: $(widgetFile "homepage")
Question(s)
Am I setting the uid correctly in my handler code and, if so, how should I access the hardcoded SiteManager in my templates?
As often posting the question made me think of an answer, though I'd still be grateful for any better ones. Using a combination of $maybe and $case like so:
$maybe user <- uid
$case user
$of Left _
<p>There's no name
$of Right username
<p>There might be a name of #{username}
$nothing
<p>No name
got me the correct username. Please post another answer if there is a better way.
The AuthId type here is Either UserId String.
A Right value represents a "hardcoded" user which does not appear in the User table. A Left value represents a User row in the Users table.
If you want to show a name for an AuthId, you can call getAuthEntity which returns an Either User SiteManager and then process it like this:
getUserName :: Either User SiteManager -> String
getUserName (Left user) = ...get the name field from user...
getUserName (Right sitemgr) = manUserName sitemgr

how can I configure yesod with multiple routes pointing to the same entity?

I've got a yesod route with two handlers - one for GET and one for PUT:
getHotspotR :: Key Hotspot -> Handler Value
getHotspotR i = do
hotspot <- runDB $ get404 i
returnJson hotspot
putHotspotR :: Handler ()
putHotspotR = do
hotspot <- requireJsonBody
hid <- runDB $ insert $ hotspot
sendResponseCreated $ HotspotR hid
But I'm not sure what to do for the routing. If I do this:
/hotspot/#HotspotId HotspotR GET PUT
It complains that the PUT handler has the wrong airity:
Couldn't match expected type `Key Hotspot -> HandlerT App IO res0'
with actual type `HandlerT App IO ()'
The function `putHotspotR' is applied to one argument,
but its type `Handler ()' has none
But if I declare another route:
/hotspot/#HotspotId HotspotR GET
/hotspot HotspotR PUT
It complains that I've got a duplicate route:
/hotspot/#HotspotId HotspotR GET
/hotspot HotspotR PUT
Foundation.hs:48:1:
Multiple declarations of `HotspotR'
Declared at: Foundation.hs:48:1
Foundation.hs:48:1
Logically, these resources are not the same, even though they manipulate entities. HotspotR manipulates a single Hotspot. HotspotsR manipulates the set of Hotspots (e.g. by inserting into that set).
Make sure the routes are named differently.
/hotspots/ HotspotsR PUT
/hotspots/#HotspotId HotspotR GET
And then modify your put resource correspondingly.
putHotspotsR :: Handler ()
putHotspotsR = do { ... }
This will enable you to do the following in the future too.
/hotspots/ HotspotsR GET PUT -- list all hotspots, insert a hotspot
/hotspots/#HotspotId HotspotR GET PATCH -- Get a hotspot, update a hotspot.

Using `Maybe` with Data Constructor

I'm working on implementing a todo command-line app in Haskell. Thanks for Learn You a Haskell for the challenge.
In particular, I'm curious about my Action data constructor (supposed to be an enumeration basically) for my Action data type.
data Action = Add | View | Delete -- 3 options for the tood list
...
execute :: (Maybe Action) -> IO a
execute Just Add = print "Add not supported"
execute Just View = view
execute Just Delete = print "Delete not supported"
execute None = print "invalid user input"
When compiling via ghc --make ..., I get an error:
Not in scope: data constructorNone'`
How can I properly use Maybe Action? Am I incorrectly assuming that Maybe can be attached to any data type instance, i.e. constructor?
Please correct me if I'm using the wrong terminology (data type, constructor, etc).
The specific error you're getting is because the empty constructor for Maybe is Nothing, not None. However, once you fix that you'll get some other baffling error message because you need to parenthesize.
execute :: (Maybe Action) -> IO a
execute (Just Add) = print "Add not supported"
execute (Just View) = view
execute (Just Delete) = print "Delete not supported"
execute Nothing = print "invalid user input"
Otherwise, it would assume that you meant for execute to have two arguments - one for each pattern in its equations.

Getting FieldView From a Monadic Form or Separating View-related code from the Form

I was following along the Monadic Form example from the Yesod Web Framework Book (http://www.yesodweb.com/book-1.2/forms Monadic Forms section). The example shows how to construct a widget and return it from the form. However, I would like to avoid styling and view related code in my Handler / Form and I thought I can just get all the FieldView but I cannot figure out how to do this because runFormPost returns an xml (guessing that's the Widget).
Modified code from them book
personForm :: Html -> MForm Handler (FormResult Person, FieldView, FieldView)
personForm extra = do
(nameRes, nameView) <- mreq textField "this is not used" Nothing
(ageRes, ageView) <- mreq intField "neither is this" Nothing
let personRes = Person <$> nameRes <*> ageRes
return (personRes, nameView, ageView) -- my change and removed all the View related code
In my Handler I call it as:
((res, v1, v2), enctype) <- runFormPost personForm
There are a couple of issues here. (1) I get an error message that FieldView takes another parameter and unsure what it is I put () that seems to satisfy the compiler but I have no idea why that makes any sense. (2) Then I get the error message: Couldn't match expected type (FormResult a0, xml0)' with actual type(FormResult Person, FieldView (), FieldView ())'
The second one I take it to be something related to what runFormPost returns.
Could someone please help me with the best way to get the FieldViews directly so I can place them appropriately in my Hamlet file? Or if there is a better way to separate view related items from the Handler / Form, that will be fine as well.
I did not want to use Input Forms because if there is an invalid input, there seems to be no way to trap it and handle the error in the code -- it just directs to an error page.
Thanks!

Resources