Peristent with MongoDB in Servant - mongodb

I try to use persistent with MongoDB in Servant webservices APIs.
Below is my model code (Model.hs)
let mongoSettings = (mkPersistSettings (ConT ''MongoContext))
in share [mkPersist mongoSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
fam String
im String
ot String
email String
login String
pswd String
deriving Show
|]
$(deriveJSON defaultOptions ''User)
And the code to access the database:
usersGet :: AppM [User]
usersGet = do
resultDB <- runDb $ do rest =<< find (select [] "user")
return resultDB
Which gives me an error:
Error: Expected type: [User] Actual type: [Document].
I understand the error, but I thought that the library should automatically generate the necessary functions for the conversion from Document -> User.
What is function that generates for that?

Use bson-generic package to generate fromBSON and toBSON functions
Then map documents you get from the database to [User]
http://hackage.haskell.org/package/bson-generic-0.0.8.1/docs/Data-Bson-Generic.html

Related

My web app on Yesod, Auth-HashDB, and PostgreSQL refuses to compile -- Couldn't match type ‘AuthEntity App’ with ‘User’

I've been trying to give myself a crash course in Yesod, but I can't seem to figure out what I'm doing wrong here. It's likely a conceptual failing, but I've more-or-less copy-pasted the code available on various short introductions to HashDB in an attempt to make a hashed DB authentication system, but no dice.
Foundation.hs:136:23:
Couldn't match type ‘AuthEntity App’ with ‘User’
In the expression: getAuthIdHashDB AuthR (Just . UniqueUser) creds
In an equation for ‘getAuthId’:
getAuthId creds = getAuthIdHashDB AuthR (Just . UniqueUser) creds
In the instance declaration for ‘YesodAuth App’
From each segment of code that's relevant:
config/models:
User
name Text
password Text Maybe
UniqueUser name
Model.hs:
import Yesod.Auth.HashDB (HashDBUser, userPasswordHash, setPasswordHash)
import Database.Persist.Quasi (lowerCaseSettings)
...
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
instance HashDBUser User where
userPasswordHash = userPassword
setPasswordHash h u = u { userPassword = Just h }
Foundations.hs:
...
import Yesod.Auth
import Yesod.Auth.HashDB (authHashDBWithForm, getAuthIdHashDB, authHashDB)
import Yesod.Auth.Message (AuthMessage (InvalidLogin))
...
instance YesodAuth App where
type AuthId App = UserId
loginDest _ = HomeR
logoutDest _ = HomeR
redirectToReferer _ = True
authPlugins _ = [ authHashDB (Just . UniqueUser) ]
getAuthId creds = getAuthIdHashDB AuthR (Just . UniqueUser) creds
authHttpManager = getHttpManager
Any help would be appreciated. I still kind of suck at Haskell, so this is also my attempt at a crash course in it as well.
This typically means that you don't have an AuthEntity associated type declared, which in turn means that you don't have a YesodAuthPersist instance. In your case, this is probably just:
instance YesodAuthPersist App where
type AuthEntity App = User
This is provided by the Yesod scaffolding.

How to retrieve the value from the data attribute in node js via form submit with method post

How to get the value from the data attribute in node js via form submit.
I want to get a 2nd information from user!
My first try was this:
Clientside:
input(type="submit" ,name="responseValue" , value="yes", data="question1" )
input(type="submit" ,name="responseValue" , value="no", data="question2" )
Serverside:
//works ok
var responseValue = req.body.responseValue;
//following does not work
var questionNumber = req.body.data
Is there any solution for this without a hidden field ?
You can concatenate string in the value field and then separate it at server side.
Your client side may look like this.
input(type="submit",name="responseValue", value="yes,question1")
Then at server side you can separate the string responseValue by the index of ','.

store (binary) file - play framework using scala in heroku

I'm trying to store user-uploaded images in my application which is written by scala and play framework 2.2.x
I've deployed my app in heroku.
Heroku does not allow me to save my file in file system.
So I've tried to store my file in data base.
here is the code that I use for storing image :
def updateImage(id: Long, image: Array[Byte]) = {
val selected = getById(id)
DB.withConnection {
implicit c =>
SQL("update subcategory set image={image} where id = {id}").on('id -> id, 'image -> image).executeUpdate()
}
selected }
and here is the code that I use to retreive my image :
def getImageById(id: Long): Array[Byte] = DB.withConnection {
implicit c =>
val all = SQL("select image from subcategory where id = {id}").on('id -> id)().map {
case Row(image: Array[Byte]) => image
case Row(Some(image: Array[Byte])) => image
case Row(image: java.sql.Blob )=> image.getBytes(0 , image.length().toInt)
}
all.head
}
The problem is: when I use H2 database and blob column, I get the "Match Error" exception.
When I use Postgresql and bytea column, I got no error but when I retrieve the image, It's in hex format and some of the bytes in the beginning of the array are missing.
According to the PostgreSQL documentation, bytea stores the length of the array in the four bytes at the beginning of the array. These are stripped when you read the row, so that's why they seem to be "missing" when you compare the data in Scala with the data in the DB.
You will have to set the response's content-type to the appropriate value if you want the web browser to display the image correctly, as otherwise it does not know it is receiving image data. The Ok.sendFile helper does it for you. Otherwise you will have to do it by hand:
def getPicture = Action {
SimpleResult(
header = ResponseHeader(200),
body = Enumerator(pictureByteArray))
.as(pictureContentType)
}
In the example above, pictureByteArray is the Array[Byte] containing the picture data from your database, and pictureContentType is a string with the appropriate content type (for example, image/jpeg).
This is all quite well explained in the Play documentation.

Haskell Snap: mongodb field type error

I get an error which I can't resolve.
The snap application compiles without a problem and everything seems to be ok.
But when I render the relevant page in a browser I get this error:
A web handler threw an exception. Details:
expected ("code" :: Integer) in [ _id: 50b56f19208c2e9a09dccc2b, id: 1.0, code: "hdg435", name: "froggy"]
The code value is just a rendom string I picked for testing. I am not sure why an integer is expected?
These are the relevant parts of an example snap application.
getData :: IO [Document]
getData = do
pipe <- runIOE $ connect $ host "127.0.0.1"
let run act = access pipe master "test" act
result <- run (find (select [] "pcs") >>= rest)
close pipe
return $ either (const []) id result
mkSplice :: Document -> Splice AppHandler
mkSplice d = runChildrenWithText [dtp "id" d
,dtp "code" d
,dtp "name" d
]
dtp :: Text -> Document -> (Text,Text)
dtp tag d = (tag, T.pack $ show $ at tag d)
recSplice :: Splice AppHandler
recSplice = mapSplices mkSplice =<< liftIO getData
table :: Handler App App ()
table = heistLocal (bindSplice "rec" recSplice) $ render "table"
The relevant Heist template part of table.tpl is here:
<table>
<tbody>
<rec>
<tr><td><id/></td><td><code/></td><td><name/></td></tr>
</rec>
</tbody>
</table>
Please let me know what other parts of code need to be posted.
When I compile your dtp function I get:
import Data.Bson
import Data.Text (Text)
import qualified Data.Text as T
dtp :: Text -> Document -> (Text,Text)
dtp tag d = (tag, T.pack $ show $ at tag d)
Ambiguous type variable `a0' in the constraints:
(Show a0)
[...]
which makes perfect sense. It seems like in your case it's defaulting to Integer when you really want String. You can try adding a signature or better yet, just:
dtp tag d = (tag, at tag d)
If you want this to work for other types, you'll have to work harder.
UPDATE
Here's a GHCi session that illustrates the problem and how GHCi seems to default the Show instance to Integer:
Prelude Data.Bson> show $ at "hello" ["hello" =: "world"]
"*** Exception: expected ("hello" :: Integer) in [ hello: "world"]

Processing form with Yesod and using the inputs to create something defined in models

The crux of the action is in this file:
https://github.com/gdoteof/exodus/blob/42c5ee09f09dcb718fa3bdfd79bfe5182c03faaa/Handler/GamingSession.hs
The general idea that I am going for is to accept POSTED input, and use that input, combined with the UTCTime from getCurrentTime to create a new GamingSession.
Then the GamingSession would be inserted into the database.
What's happening now at /session is a form that posts to /session, with prefilled in values. But I am getting an error
Prelude.read: no parse
(relevant config/routes: https://github.com/gdoteof/exodus/blob/d07bea21e7699b44739ceadf3c3a18533a9ef462/config/routes
)
When I have a form for persist keys, I usually prefer a drop down rather than manual entry. Try the code below. Also, try to follow the idiomatic style in the book, it will help.
gs <- runInputPost $ GamingSession
start
Nothing
<$> ireq (selectField (optionsPersistKey [] [] (toPathPiece . entityKey))) "player"
<*> ireq (selectField (optionsPersistKey [] [] (toPathPiece . entityKey))) "table"
<*> iopt intField "seat"
-- | The optionsPersist builtin to the Yesod.Forms package unfortunately only
-- works well with whole persist entities. We are only interested in the entity
-- id s which is why we add in this function here:
optionsPersistKey
:: (YesodPersist master
, PersistEntity a
, PersistQuery (YesodPersistBackend master) (GHandler sub master)
, PathPiece (Key (YesodPersistBackend master) a)
, RenderMessage master msg
, PersistEntityBackend a ~ YesodPersistBackend master)
=> [Filter a]
-> [SelectOpt a]
-> (Entity a -> msg)
-> GHandler sub master (OptionList (Key (PersistEntityBackend a) a))
optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do
mr <- getMessageRender
pairs <- runDB $ selectList filts ords
return $ map (\(Entity key value) -> Option
{ optionDisplay = mr (toDisplay $ Entity key value)
, optionInternalValue = key
, optionExternalValue = toPathPiece key
}) pairs
You're getting a read fail b/c you're trying to read values like "4f6150251c21230c78000000" to PersistInt64. The MongoDB backend does not use PersistInt64s for key values so that code won't build a proper key for your setup. I'd try PersistText.
The error you're getting means the input does not look like a normal integer. What do the prefilled values actually look like? The strings from ireq textField "player" and ireq textField "table" have to just contain a number possibly padded with whitespace.
Also, to make handling bad parses easier, you should look at the safe package. This contains a version of read (and similar functions) that returns a Maybe, so you get a Nothing instead of an exception if it can't parse the input.
Ok, try this:
import Data.Text (unpack)
...
(player, table, seat) <- runInputPost $ (,,)
<$> (ireq textField "player")
<*> (ireq textField "table")
<*> iopt intField "seat"
playerId <- maybe (invalidArgs ["couldn't parse: ", player]) return $ fromPathPiece player
tableId <- maybe (invalidArgs ["couldn't parse: ", table]) return $ formPathPiece table
let gs = GamingSession start Nothing playerId tableId seat
...
changing
textToKey = Key . PersistText . read . unpack
to
textToKey a = fromJust . fromPathPiece $ a
fixed it for me