Scotty: connection pool as monad reader - haskell

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

Related

Haskell: Keeping track and modifying state with Scotty HTTP API

Can I modify my state using IO via the Scotty API? Currently, I have a state transformer inside IO monad to modify state with user input. But I want to achieve this via the Scotty API.
This is my state transformer types I currently have that I use to keep modifying the state type and allow for IO actions.
-- State Transformer type inside IO monad
type STIO st a = STM st IO a
-- State transformer inside a monad
newtype STM st m a = S (st -> m (a, st))
... and with this lift functions to lift an action into the IO monad:
lift :: Monad m => m a -> STM st m a
lift mx = S (\s -> do
x <- mx
return (x, s))
This is my current bare bones Scotty server:
port = 8080
main = server
server :: IO ()
server = do
print ("Starting Server at port " ++ show port)
scotty port $ do
get "/start" $ do
json ("{starting: "++"True"++"}")
In my head I am wanting something along these lines, but unsure how to implement it:
type State = Int
server :: STIO State ()
server = do
print ("Starting Server at port " ++ show port)
lift $ scotty port $ do
get "/start" $ do
updateCounterByOneInState
counter <- getCounterFromState
json $ "{count: " ++ counter ++ "}"
Is something like this even possible, or am I just getting confused?
Scotty, like all WAI applications, needs to be prepared to handle multiple concurrent requests in separate threads. This poses a bit of a problem for your STIO monad, since it doesn't directly support concurrent access to the state. You'd need to arrange to load the state, run the handlers, and save the state in a way that's concurrency-safe.
Technically, you can do this with help from the functions in Web.Scotty.Trans, but it's not a very good idea. For example, the following self-contained example stores the state in a concurrency-safe MVar:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
import Web.Scotty.Trans as W
import Control.Monad.State as S
import Control.Concurrent.MVar
import Network.Wai.Handler.Warp (Port)
import Data.Text.Lazy (Text)
type STIO s = StateT s IO
scottySTIO :: MVar s -> Port -> ScottyT Text (STIO s) () -> (STIO s) ()
scottySTIO sref p = scottyT p $ \act -> do
s <- takeMVar sref
(r, !s') <- runStateT act s
putMVar sref s'
return r
server :: STIO Int ()
server = do
let port = 8080
liftIO $ print ("Starting Server at port " ++ show port)
s <- S.get
sref <- liftIO $ newMVar s
scottySTIO sref port $ do
W.get "/start" $ do
modify (+1)
counter <- S.get
json $ "{count: " ++ show counter ++ "}"
main :: IO ()
main = evalStateT server 0
This will "work", but it will exhibit horrible concurrency performance because it ends up serializing all requests in their entirety, instead of just protecting critical code sections. It really only makes sense if you already have a huge amount of code running in the STIO monad, you don't want to modify any of it, and you're willing to take the performance hit.
Most of the time, it will be much easier to refactor your design to store the state in a concurrency-safe manner and access it directly from IO. For example, the counter can be stored in a single MVar and safely accessed in a short critical section:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
import Web.Scotty
import Control.Concurrent.MVar
import Control.Monad.IO.Class
main :: IO ()
main = do
let port = 8080
print ("Starting Server at port " ++ show port)
sref <- newMVar (0 :: Int)
scotty port $ do
get "/start" $ do
-- start of critical section
counter <- liftIO $ takeMVar sref
let !counter' = counter + 1
liftIO $ putMVar sref counter'
-- end of critical section
json $ "{count: " ++ show counter' ++ "}"

Scotty monad transformer for per-handler Reader

In the question Web, Scotty: connection pool as monad reader it is shown how to use ScottyT to embed a Reader monad in the stack to access a static configuration (in that case, a connection pool).
I have a similar question, but simpler – or at least I thought so…
I want to add a Reader to a single handler (i.e. a ActionT), not the whole app.
I started modifying the program from the question above, but I cannot figure out how to turn an ActionT Text (ReaderT String IO) into the ActionT Text IO the handler needs to be. After fumbling around and trying to use typed holes hoping to see how to construct this I have to give up for now and ask for help. I really feel this should be simple, but cannot figure out how to do this.
Here's the program, with the lines where I'm stuck highlighted:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text.Lazy as T
import Data.Text.Lazy (Text)
import Control.Monad.Reader
import Web.Scotty.Trans
type ActionD = ActionT Text (ReaderT String IO)
main :: IO ()
main = do
scottyT 3000 id id app
-- Application
app :: ScottyT Text IO ()
app = do
get "/foo" $ do
h <- handler -- ?
runReaderT h "foo" -- ?
--get "/bar" $ do
-- h <- handler
-- runReaderT h "bar"
-- Route action handler
handler :: ActionD ()
handler = do
config <- lift ask
html $ T.pack $ show config
If you want to run each action in a separate reader, you don't need the more complex Scotty.Trans interface at all. You can just build you monad stack the other way around, with ReaderT on top.
import qualified Data.Text.Lazy as T
import Control.Monad.Reader
import Web.Scotty
type ActionD = ReaderT String ActionM
main :: IO ()
main = do
scotty 3000 app
-- Application
app :: ScottyM ()
app = do
get "/foo" $ do
runReaderT handler "foo"
-- Route action handler
handler :: ActionD ()
handler = do
config <- ask
lift $ html $ T.pack $ show config

Composing IO Monads using do

I have code in the Reader Monad, so as to pass a file handle as an invisible parameter down the Reader chain.
In writeMail, I am trying to create a Reader, which, when run using runReader, produces an IO () output which is itself the result of a chain of IO monads
writeMail :: Reader Handle (IO ())
writeMail mail = do
wmh <- writeMailHeaders mail
wmb <- writeMailBody mail
return $ wmh >>= \_ -> wmb
However I am finding that only the last in the IO chain i.e. wmb, prints at the console.
Can anyone see what I should be doing to get wmh, then wmb to print?
With simpler example:
module Read where
import Data.Functor.Identity
write :: Monad m => m (IO ())
write = do
a <- return $ putStrLn "foo"
b <- return $ putStrLn "bar"
return $ a >> b
main :: IO ()
main = runIdentity write
main prints both "foo" and "bar". So I suspect the error is in writeMailHeaders.
What you need is not just a reader, but a ReaderT monad transformer with IO as a base monad.
Since your example was incomplete, I made some changes to show your options:
import Control.Monad.Reader
writeMail :: ReaderT Handle IO ()
writeMail = do
-- Here's how you get your handle to further do something to it:
handle <- ask
-- Here's how you do the IO actions.
-- Notice the `lift` function,
-- which allows us to run actions of the base monad,
-- which in that case is `IO`.
lift $ do
print "bla bla"
print "bla"

Extending the ServerPartT Monad with a Reader

I am writing a Happstack server and I have a MongoDB database to connect to. For that, I made a function to create a connection pool
type MongoPool = Pool IOError Pipe
withMongo :: (MongoPool -> IO a) -> IO ()
withMongo f = do
pool <- dbPool
f pool
killAll pool
And then a function to run an Action with a created pool:
runDB :: (MonadIO m) => MongoPool -> Action IO a -> m (Either Failure a)
runDB pool f = liftIO $ do
pipe <- runIOE $ aResource pool
access pipe master dbName f
It's obvious this requires to carry the pool in all the routes as a parameter. I would like to wrap it into a ReaderT, so that runDB can have a type like Action IO a -> ServerPart (Either Failure a) or even better, Action IO a -> ServerPart a in which a failure will result in an HTTP Error 500 automatically.
I have a trouble wrapping my head around how that can be achieved and I'd love for some hints from people who've more experience with Haskell monads and happstack.
Thanks.
Through this question I found another with a very good hint, and I have built this. It seems to work fine and I thought I'd share it:
type MongoPool = Pool IOError Pipe
type DBServerPart a = ReaderT MongoPool (ServerPartT IO) a
hostName = "127.0.0.1"
dbName = "test"
defaultPoolSize = 10
runDB :: Action IO a -> DBServerPart (Either Failure a)
runDB f = do
pool <- ask
liftIO $ do
pipe <- runIOE $ aResource pool
access pipe master dbName f
withMongo :: DBServerPart a -> ServerPart a
withMongo f = do
pool <- liftIO $ dbPool
a <- runReaderT f pool
liftIO $ killAll pool
return a
dbPool = newPool fac defaultPoolSize
where fac = Factory {
newResource = connect $ host hostName,
killResource = close,
isExpired = isClosed
}

How to create a Database Monad Stack in Happstack?

I want to create a Happstack application with lots of access to a database. I think that a Monad Stack with IO at the bottom and a Database Write-like monad on top (with log writer in the middle) will work to have a clear functions in each access, example:
itemsRequest :: ServerConfig -> ServerPart Response
itemsRequest cf = dir "items" $ do
methodM [GET,HEAD]
liftIO $ noticeM (scLogger cf) "sended job list"
items <- runDBMonad (scDBConnString cf) $ getItemLists
case items of
(Right xs) -> ok $ toResponse $ show xs
(Left err) -> internalServerError $ toResponse $ show err
With:
getItemList :: MyDBMonad (Error [Item])
getItemList = do
-- etc...
But I have little knowledge of Monad and Monad Transformers (I see this question as an exercise to learn about it), and I have no idea how to begin the creation of Database Monad, how to lift the IO from happstack to the Database Stack,...etc.
Here is some minimal working code compiled from snippets above for confused newbies like me.
You put stuff into AppConfig type and grab it with ask inside your response makers.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Happstack.Server
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as C
myApp :: AppMonad Response
myApp = do
-- access app config. look mom, no lift!
test <- ask
-- try some happstack funs. no lift either.
rq <- askRq
bs <- lookBS "lol"
-- test IO please ignore
liftIO . print $ test
liftIO . print $ rq
liftIO . print $ bs
-- bye
ok $ toResponse ("Oh, hi!" :: C.ByteString)
-- Put your stuff here.
data AppConfig = AppConfig { appSpam :: C.ByteString
, appEggs :: [C.ByteString] } deriving (Eq, Show)
config = AppConfig "THIS. IS. SPAAAAAM!!1" []
type AppMonad = ReaderT AppConfig (ServerPartT IO)
main = simpleHTTP (nullConf {port=8001}) $ runReaderT myApp config {appEggs=["red", "gold", "green"]}
You likely want to use 'ReaderT':
type MyMonad a = ReaderT DbHandle ServerPart a
The Reader monad transformer makes a single value accessible using the ask function - in this case, the value we want everyone to get at is the database connection.
Here, DbHandle is some connection to your database.
Because 'ReaderT' is already an instance of all of the happstack-server type-classes all normal happstack-server functions will work in this monad.
You probably also want some sort of helper to open and close the database connection:
runMyMonad :: String -> MyMonad a -> ServerPart a
runMyMonad connectionString m = do
db <- liftIO $ connect_to_your_db connectionString
result <- runReaderT m db
liftIO $ close_your_db_connection db
(It might be better to use a function like 'bracket' here, but I don't know that there is such an operation for the ServerPart monad)
I don't know how you want to do logging - how do you plan to interact with your log-file? Something like:
type MyMonad a = ReaderT (DbHandle, LogHandle) ServerPart a
and then:
askDb :: MyMonad DbHandle
askDb = fst <$> ask
askLogger :: MyMonad LogHandle
askLogger = snd <$> ask
might be enough. You could then build on those primitives to make higher-level functions. You would also need to change runMyMonad to be passed in a LogHandle, whatever that is.
Once you get more than two things you want access to it pays to have a proper record type instead of a tuple.

Categories

Resources