How to, for example, insert a new User into a database using Yesod application's models? Or is there a better way?
I am dealing with scaffolded application. Now I created App instance and dont know how to perform requests using it.
:i Extra
data Extra
= Extra {extraCopyright :: Data.Text.Internal.Text,
extraAnalytics :: Maybe Data.Text.Internal.Text}
-- Defined in `Settings
let e = Extra "asdf" Nothing
let c = AppConfig {appEnv = Development, appPort = 3000, appRoot = "/", appHost = "localhost", appExtra = e}
f <- makeFoundation c
:t f
f :: App
:i App
data App
= App {settings :: AppConfig DefaultEnv Extra,
getStatic :: Yesod.Static.Static,
connPool :: persistent-1.2.3.0:Database.Persist.Class.PersistConfig.PersistConfigPool
PersistConf,
httpManager :: http-client-0.2.0.1:Network.HTTP.Client.Types.Manager,
persistConfig :: PersistConf,
appLogger :: Yesod.Core.Types.Logger}
-- Defined in `Foundation'
What next?
If you just want to do Persistent queries in ghci you can do this without creating a Yesod application. Unfortunately doing this is differs quite a bit depending on the specific back end you want to use.
For SQLite:
> import Database.Persist.Sqlite
> import Model
> pool <- createSqlitePool "yesod-test.sqlite3" 2
> runSqlite "yesod-test.sqlite3" (runMigration migrateAll)
> userId <- runSqlite "yesod-test.sqlite3" (insert (User "foo#bar.com" Nothing))
For Postgresql:
-- In Shell: $ createdb yesod-test
> import Database.PostgreSQL.Simple
> con <- connectPostgreSQL "dbname=yesod-test"
> import Database.Persist.Postgresql
> pcon <- openSimpleConn con
> import Model
> runSqlPersistM (runMigration migrateAll) pcon
> userId <- runSqlPersistM (insert (User "foo#bar.com" Nothing)) pcon
> Just user <- runSqlPersistM (get userId) pcon
> userIdent user
The scaffolding provides (at least with yesod-bin 1.4.5) a function db in Application.hs which you can use:
$ cabal repl
...
*Application> db $ insert $ User "foo#bar.com" Nothing
It looks like the accepted answer is pretty old. Here is an update for running persistent queries in IO with the postgresql backend.
import Control.Monad.Reader (ReaderT)
import Control.Monad.Logger (LoggingT, runStdoutLoggingT)
import Database.Persist.Sql (SqlBackend, runSqlConn)
import Database.Persist.Postgresql (withPostgresqlConn)
runDBIO :: ReaderT SqlBackend (LoggingT IO) a -> IO a
runDBIO = runStdoutLoggingT . withPostgresqlConn "dbname=test-db" . runSqlConn
Related
First up, I have a large Sqlite database. I want to copy a subset of the data in this database to another Sqlite database in a streaming fashion using the Haskell persistent library.
Here's the only I managed to do it, but its very slow (and uses more memory) compared to loading the data in memory and then writing it to the new database.
import Database.Persist.Sqlite (SqliteConf(..), runSqlite, runMigration, runSqlPersistMPool)
import Database.Persist (entityVal, Entity, createPoolConfig)
import Data.Pool (Pool)
import Data.Conduit (ConduitT, (.|), runConduit)
import qualified Data.Conduit.List as CL
main :: RIO App ()
main = do
ipool <- liftIO $ createPoolConfig (SqliteConf "mydb.db" 1)
opool <- liftIO $ createPoolConfig (SqliteConf "mydbsmall.db" 1)
liftIO $ flip runSqlPersistMPool opool $ do
runMigration migrateAll
liftIO $ flip runSqlPersistMPool ipool $ do
runConduit $ selectSource (distinct $ from $ \pays -> return pays) .| (migrate opool)
migrate :: (Monad m, MonadIO m)
=> Pool SqlBackend
-> ConduitT (Entity Pays) Void m ()
migrate pool = CL.mapM_ (\e -> liftIO $ flip runSqlPersistMPool pool $ insertKey (entityKey e) (entityVal e))
The problem is in the migrate function since I'm calling runSqlPersistMPool on every single data in my conduit stream.
What is the right way to do it ?
I am writing an API server using Servant. The server includes persistent state. I would like to use QuickCheck to write tests for the server.
The implementation of various endpoints that make up the Servant Application require a database value. Unsurprisingly, creation of the database value is in the IO monad.
I don't understand how to combine the pieces from Hspec, Wai, QuickCheck, and Servant in a way that satisfies them all.
I see that I can perform an IO as part of creating the Hspec Spec itself and I see that I can specify that an IO be performed before each item in the Hspec Spec. Neither of these capabilities seems helpful in this case. The IO needs to be performed for each QuickCheck iteration of the property. Without this, the database accumulates state from each iteration which invalidates the definition of the property (or at least makes it greatly more complicated).
Below is my attempt to create a minimal, self-contained example of this scenario.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Data.IORef
import Test.QuickCheck
import Test.QuickCheck.Monadic
import qualified Test.Hspec.Wai.QuickCheck as QuickWai
import Test.Hspec
import Test.Hspec.Wai
import Text.Printf
import Servant
import Servant.API
import Data.Aeson
import Data.Text.Encoding
import Data.ByteString.UTF8
( fromString
)
data Backend = Backend (IORef Integer)
openBackend :: Integer -> IO Backend
openBackend n = Backend <$> newIORef n
data Acknowledgement = Ok Integer
instance ToJSON Acknowledgement where
toJSON (Ok n) = object [ "value" .= n ]
serveSomeNumber :: Backend -> Integer -> IO Acknowledgement
serveSomeNumber (Backend a) b = do
a' <- readIORef a
modifyIORef a (\n -> n + 1)
return $ Ok (a' + b)
type TheAPI = Capture "SomeNumber" Integer :> Post '[JSON] Acknowledgement
theServer :: Backend -> Server TheAPI
theServer backend = liftIO . serveSomeNumber backend
theAPI :: Proxy TheAPI
theAPI = Proxy
app :: Backend -> Application
app backend = serve theAPI (theServer backend)
post' n =
let
url = printf "/%d" (n :: Integer)
encoded = fromString url
in
post encoded ""
spec_g :: Backend -> Spec
spec_g (Backend expectedResult) =
describe "foo" $
it "bar" $ property $ \genN -> monadicIO $ do
n <- run genN
m <- run $ readIORef expectedResult
post' n `shouldRespondWith` ResponseMatcher { matchStatus = fromInteger (n + m) }
main :: IO ()
main = do
spec_g' <- spec_g `fmap` openBackend 16
hspec spec_g'
This doesn't type check:
/home/exarkun/Scratch/QuickCheckIOApplication/test/Spec.hs:119:3: error:
* Couldn't match type `WaiSession' with `PropertyM IO'
Expected type: PropertyM IO ()
Actual type: WaiExpectation
* In a stmt of a 'do' block:
post' n
`shouldRespondWith`
ResponseMatcher {matchStatus = fromInteger (n + m)}
In the second argument of `($)', namely
`do n <- run genN
m <- run $ readIORef expectedResult
post' n
`shouldRespondWith`
ResponseMatcher {matchStatus = fromInteger (n + m)}'
In the expression:
monadicIO
$ do n <- run genN
m <- run $ readIORef expectedResult
post' n
`shouldRespondWith`
ResponseMatcher {matchStatus = fromInteger (n + m)}
|
119 | post' n `shouldRespondWith` ResponseMatcher { matchStatus = fromInteger (n + m) }
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
I don't know if there is a way to fit a WaiExpectation into a PropertyM IO () at all. I don't even know if monadicIO is helpful here at all.
How can I fit these pieces together?
Define spec_g :: Background -> Spec, then take advantage of IO's Functor and Monad instances.
main = do
spec <- fmap spec_g (openBackend 16) -- fmap spec_g :: IO Background -> IO Spec
hspec spec
or more concisely,
main = spec_g <$> openBackend 16 >>= hspec
IIRC, you're supposed to run each spec or property with the with function. Here's a few properties I wrote some time ago:
with app $ describe "/reservations/" $ do
it "responds with 404 when no reservation exists" $ WQC.property $ \rid ->
get ("/reservations/" <> toASCIIBytes rid) `shouldRespondWith` 404
it "responds with 200 after reservation is added" $ WQC.property $ \
(ValidReservation r) -> do
_ <- postJSON "/reservations" $ encode r
let actual = get $ "/reservations/" <> toASCIIBytes (reservationId r)
actual `shouldRespondWith` 200
The app value serves the service, and as far as I recall, it runs the IO action for each test. I did it with an in-memory database using an IORef, and that seems to be working just fine:
app :: IO Application
app = do
ref <- newIORef Map.empty
return $
serve api $
hoistServer api (Handler . runInFakeDBAndIn2019 ref) $
server 150 []
The WQC.property function is from a qualified import:
import qualified Test.Hspec.Wai.QuickCheck as WQC
I wasn't too happy, however, with the way I had to structure my tests and properties with HSpec, so I ultimately rewrote all the tests to be driven by HUnit. I've an upcoming blog post that describes this, but I haven't published it yet.
I have a problem with compile haskell program. Code should make simple rest api with persistance. I use postgres as database engine. When I type stack build I gets an error
• Couldn't match type ‘IO’ with ‘Control.Monad.Logger.LoggingT IO’
Expected type: Control.Monad.Logger.LoggingT IO ()
Actual type: IO ()
• In the second argument of ‘($)’, namely
‘Db.withPostgresqlPool connStr 10
$ \ pool
-> do runDB pool $ Db.runMigration migrateAll
scotty 5001 $ do ...’
In the expression:
runStderrLoggingT
$ Db.withPostgresqlPool connStr 10
$ \ pool
-> do runDB pool $ Db.runMigration migrateAll
scotty 5001 $ do ...
In an equation for ‘main’:
main
= runStderrLoggingT
$ Db.withPostgresqlPool connStr 10
$ \ pool
-> do runDB pool $ Db.runMigration migrateAll
....
|
20 | main = runStderrLoggingT $ Db.withPostgresqlPool connStr 10 $ \pool -> do
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
-- While building custom Setup.hs for package App-0.1.0.0 using:
/home/lukasz/.stack/setup-exe-cache/x86_64-linux/Cabal-simple_mPHDZzAJ_2.0.1.0_ghc-8.2.2 --builddir=.stack-work/dist/x86_64-linux/Cabal-2.0.1.0 build exe:App --ghc-options " -ddump-hi -ddump-to-file -fdiagnostics-color=always"
Process exited with code: ExitFailure 1
I don't known why.
My code:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Monad.IO.Class (liftIO)
import Network.HTTP.Types
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.Static
import Web.Scotty
import Control.Monad.Logger (runStderrLoggingT)
import qualified Database.Persist.Postgresql as Db
import Models
import ModelsJson
main :: IO()
main = runStderrLoggingT $ Db.withPostgresqlPool connStr 10 $ \pool -> do
-- Migrate database
runDB pool $ Db.runMigration migrateAll
-- Start server
scotty 5001 $ do
middleware logStdoutDev
-- * Static content middleware
--middleware $ staticPolicy (noDots >-> addBase "public")
get "/" $
html $ "<h1>Backend API server (haskell Scotty)</h1>"
-- * CRUD
get "/api/users" $ do
(users :: [Db.Entity User]) <-
liftIO $ runDB pool $ Db.selectList [] []
json users
post "/api/users" $ do
(user :: User) <- jsonData
uid <- liftIO $ runDB pool $ Db.insert user
json $ Db.Entity uid user
connStr :: Db.ConnectionString
connStr = "host=localhost dbname=road_free_development user=cidevant password='' port=5432"
runDB :: Db.ConnectionPool -> Db.SqlPersistM a -> IO a
runDB = flip Db.runSqlPersistMPool
I get this code from this source https://gist.github.com/konstantinwebarchitect/11231173
Can anyone help me? I'm new in haskell.
Looks like something inside the big lambda forces it to be of type IO a instead of the correct LoggerT IO a, which in turn forces result if Db.with... be of IO a type.
It looks like the reason is in the runDb call, it should be wrapped into liftIO like in other places of your code, but I cannot verify it now.
The following code tries to combine two examples that work separately:
day 19 of 24 (2012) and e.g. ws example but I took almost everything websocket related away to get a small example.
Please, find the code below. The msgHandler is called by helloDb, which will get the the snaplet containing the db-connection and pass it to the msgHandler. The snaplet-posgresql-simple docs (at the end) give convenience instances and an example how to use one of them in the Initializer monad.
When I take the two commented lines away, ghc say that there are two instances involving out-of-scope types and that instances do overlapp: HasPostgres (ReaderT r m) and HasPostgres (ReaderT (Snaplet Postgres) m).
So the question is, how to get the program to compile so that I could pass db-connection from the snaplet to the websocket-part.
My goal is to make the websocket listen for messages, query db, and send messages pack. Other things that I already tried:
aFun :: (MonadIO m, HasPostgres m) => ... m (..) having both db-queries and websocket-things (both liftIO'd) compiles until WS.runWebSocketsSnap calls directly or indirectly aFun.
Tried to tell msgHandler :: (MonadIO m, HasPostgres m) but then ghc says that there is no instance for HasPosgres IO. My feeling is that this should be doable without IO-instance. Or is it?
The code below is trying to use snaplet in non-snaplet context but I'm not sure if this is the correct way.
Is there a better approach to combining websockets and (db-) snaplets in snapframework? After trying several approaches I'm in serious mental lock state obviously needing help. Any help (even small hints about what kind of things I should start learning/refreshing), will be highly appreciated!
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Maybe
import Data.Monoid ((<>))
import Control.Lens
import Control.Monad.Trans
import Control.Monad.Reader
import Snap.Snaplet
import Snap.Snaplet.PostgresqlSimple
import Snap.Http.Server
import Snap.Core as SC
import Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Snap as WS
newtype App = App { _db :: Snaplet Postgres }
makeLenses ''App
msgHandler :: (MonadIO m) => App -> BS.ByteString -> WS.PendingConnection -> m ()
msgHandler appSt mUId pending = do
conn <- liftIO $ WS.acceptRequest pending
-- res <- liftIO $ runReaderT (query "SELECT name FROM users WHERE id = ?" (Only mUId)) dbSnaplet
-- liftIO $ print (res :: [Name])
liftIO $ T.putStrLn "msgHandler ended"
where dbSnaplet = view db appSt
initApp :: SnapletInit App App
initApp = makeSnaplet "myapp" "My application" Nothing $
App <$> nestSnaplet "db" db pgsInit
<* addRoutes [("/hello/:id", helloDb)]
newtype Name = Name { _nm :: Text } deriving (Show, Eq)
instance FromRow Name where fromRow = Name <$> field
helloDb :: Handler App App ()
helloDb = do
Just mUId <- getParam "id"
userName <- with db $ listToMaybe <$> query "SELECT name FROM users WHERE id = ?" (Only mUId)
writeText $ maybe "User not found" (\h -> "Hello, " <> (T.pack . show) h) (userName :: Maybe Name)
sStApp <- getSnapletState
WS.runWebSocketsSnap $ msgHandler (view snapletValue sStApp) mUId
main :: IO ()
main = serveSnaplet defaultConfig initApp
The overlapping instance issue you ran into is a bug in the snaplet-postgresql-simple library that has been fixed but the fix has not yet been released. You might want to ask the maintainer about this.
In the meantime you can either pull the latest version of the library from Github, or redefine a type different but isomorphic to ReaderT (Snaplet Postgres), copying the HasPostgres instance.
There are trillions of monad tutorial including the reader and it seems all clear when you read about it. But when you actually need to write, it becomes a different matter.
I'v never used the Reader, just never got to it in practice. So I don't know how to go about it although I read about it.
I need to implement a simple database connection pool in Scotty so every action can use the pool. The pool must be "global" and accessible by all action functions. I read that the way to do it is the Reader monad. If there are any other ways please let me know.
Can you please help me and show how to do this with the Reader correctly?
I'll probably learn faster if I see how it is done with my own examples.
{-# LANGUAGE OverloadedStrings #-}
module DB where
import Data.Pool
import Database.MongoDB
-- Get data from config
ip = "127.0.0.1"
db = "index"
--Create the connection pool
pool :: IO (Pool Pipe)
pool = createPool (runIOE $ connect $ host ip) close 1 300 5
-- Run a database action with connection pool
run :: Action IO a -> IO (Either Failure a)
run act = flip withResource (\x -> access x master db act) =<< pool
So the above is simple. and I want to use the 'run' function in every Scotty action to access the database connection pool. Now, the question is how to wrap it in the Reader monad to make it accessible by all functions? I understand that the 'pool' variable must be 'like global' to all the Scotty action functions.
Thank you.
UPDATE
I am updating the question with the full code snippet. Where I pass the 'pool' variable down the function chain. If someone can show how to change it to utilize the monad Reader please.
I don't understand how to do it.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Network.HTTP.Types
import Web.Scotty
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Internal
import Data.Monoid (mconcat)
import Data.Aeson (object, (.=), encode)
import Network.Wai.Middleware.Static
import Data.Pool
import Database.MongoDB
import Control.Monad.Trans (liftIO,lift)
main = do
-- Create connection pool to be accessible by all action functions
pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
scotty 3000 (basal pool)
basal :: Pool Pipe -> ScottyM ()
basal pool = do
middleware $ staticPolicy (noDots >-> addBase "static")
get "/json" (showJson pool)
showJson :: Pool Pipe -> ActionM ()
showJson pool = do
let run act = withResource pool (\pipe -> access pipe master "index" act)
d <- lift $ run $ fetch (select [] "tables")
let r = either (const []) id d
text $ LT.pack $ show r
Thanks.
UPDATE 2
I tried to do it the way it was suggested below but it does not work.
If anyone has any ideas, please. The list of compile errors is so long that I don't even know where to begin ....
main = do
pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
scotty 3000 $ runReaderT basal pool
basal :: ScottyT LT.Text (ReaderT (Pool Pipe) IO) ()
basal = do
middleware $ staticPolicy (noDots >-> addBase "static")
get "/json" $ showJson
showJson :: ActionT LT.Text (ReaderT (Pool Pipe) IO) ()
showJson = do
p <- lift ask
let rdb a = withResource p (\pipe -> access pipe master "index" a)
j <- liftIO $ rdb $ fetch (select [] "tables")
text $ LT.pack $ show j
UPDATE 3
Thanks to cdk for giving the idea and thanks to Ivan Meredith for giving the scottyT suggestion. This question also helped: How do I add the Reader monad to Scotty's monad
This is the version that compiles. I hope it helps someone and saves some time.
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import Data.Text.Lazy (Text)
import Control.Monad.Reader
import Web.Scotty.Trans
import Data.Pool
import Database.MongoDB
type ScottyD = ScottyT Text (ReaderT (Pool Pipe) IO)
type ActionD = ActionT Text (ReaderT (Pool Pipe) IO)
-- Get data from config
ip = "127.0.0.1"
db = "basal"
main = do
pool <- createPool (runIOE $ connect $ host ip) close 1 300 5
let read = \r -> runReaderT r pool
scottyT 3000 read read basal
-- Application, meaddleware and routes
basal :: ScottyD ()
basal = do
get "/" shoot
-- Route action handlers
shoot :: ActionD ()
shoot = do
r <- rundb $ fetch $ select [] "computers"
html $ T.pack $ show r
-- Database access shortcut
rundb :: Action IO a -> ActionD (Either Failure a)
rundb a = do
pool <- lift ask
liftIO $ withResource pool (\pipe -> access pipe master db a)
I've been trying to figure out this exact problem myself. Thanks to hints on this SO question, and other research I've come up with the following which works for me. The key bit you were missing was to use scottyT
No doubt there is a prettier way to write runDB but I don't have much experience in Haskell, so please post it if you can do better.
type MCScottyM = ScottyT TL.Text (ReaderT (Pool Pipe) IO)
type MCActionM = ActionT TL.Text (ReaderT (Pool Pipe) IO)
main :: IO ()
main = do
pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
scottyT 3000 (f pool) (f pool) $ app
where
f = \p -> \r -> runReaderT r p
app :: MCScottyM ()
app = do
middleware $ staticPolicy (noDots >-> addBase "public")
get "/" $ do
p <- runDB dataSources
html $ TL.pack $ show p
runDB :: Action IO a -> MCActionM (Either Failure a)
runDB a = (lift ask) >>= (\p -> liftIO $ withResource p (\pipe -> access pipe master "botland" a))
dataSources :: Action IO [Document]
dataSources = rest =<< find (select [] "datasources")
Update
I guess this a bit more pretty.
runDB :: Action IO a -> MCActionM (Either Failure a)
runDB a = do
p <- lift ask
liftIO $ withResource p db
where
db pipe = access pipe master "botland" a
As you've alluded, the way to make it accessable is to wrap your computations in the Reader monad or more likely the ReaderT transformer. So your run function (changed slightly)
run :: Pool Pipe -> Action IO a -> IO (Either Failure a)
run pool act =
flip withResource (\x -> access x master db act) =<< pool
becomes
run :: Action IO a -> ReaderT (Pool Pipe) IO (Either Failure a)
run act = do
pool <- ask
withResource pool (\x -> access x master db act)
Computations inside a ReaderT r m a environment can access the r using ask and ReaderT seemingly conjures it out of thin air! In reality, the ReaderT monad is just plumbing the Env throughout the computation without you having to worry about it.
To run a ReaderT action, you use runReaderT :: ReaderT r m a -> r -> m a. So you call runReaderT on your top level scotty function to provide the Pool and runReaderT will unwrap the ReaderT environment and return you a value in the base monad.
For example, to evaluate your run function
-- remember: run act :: ReaderT (Pool Pipe) IO (Either Failure a)
runReaderT (run act) pool
but you wouldn't want to use runReaderT on run, as it is probably part of a larger computation that should also share the ReaderT environment. Try to avoid using runReaderT on "leaf" computations, you should generally call it as high up in the program logic as possible.
EDIT: The difference between Reader and ReaderT is that Reader is a monad while ReaderT is a monad transformer. That is, ReaderT adds the Reader behaviour to another monad (or monad transformer stack). If you're not familiar with monad transformers I'd recommend real world haskell - transformers.
You have showJson pool ~ ActionM () and you want to add a Reader environment with access to a Pool Pipe. In this case, you actually need ActionT and ScottyT transformers rather than ReaderT in order to work with functions from the scotty package.
Note that ActionM is defined type ActionM = ActionT Text IO, similarly for ScottyM.
I don't have all the necessary libraries installed, so this might not typecheck, but it should give you the right idea.
basal :: ScottyT Text (ReaderT (Pool Pipe) IO) ()
basal = do
middleware $ staticPolicy (...)
get "/json" showJson
showJson :: ActionT Text (ReaderT (Pool Pipe) IO) ()
showJson = do
pool <- lift ask
let run act = withResource pool (\p -> access p master "index act)
d <- liftIO $ run $ fetch $ select [] "tables"
text . TL.pack $ either (const "") show d