I wrote a function
app :: Request -> H.Session H.Postgres IO Response
which accepts web requests and builds responses (consulting the database as needed). To actually send out the responses I made a wrapper
runApp :: H.Postgres -> H.SessionSettings -> Application
runApp pg sess req respond =
respond =<< H.session pg sess (app req)
I pass this function to Warp’s runSettings to loop forever and handle requests:
runSettings appSettings $ runApp pgSettings sessSettings
However this is really bad because it creates a new session for every request which defeats the purpose of the connection pool and prepared statements.
I would like to call runSettings inside H.session rather than the other way around. However runSettings has a signature Settings -> Application -> IO () and once inside IO I have lost access to the session. Is there a way to get back inside Session b m r?
This is a repost of a question from a private email.
Yes, in your example you create a new session for every request, which is unacceptable.
First of all, Session is just and alias to the reader monad transformer, which gives you a direct access to the pool. So you can always do:
session postgresSettings sessionSettings $ do
-- session' :: H.Session b m r -> m r
session' <- flip runReaderT <$> ask
let runApp request respond =
respond =<< session' (app request)
liftIO $ do
-- run warp here
Secondly, ReaderT has a MonadBaseControl instance, which is intended for similar patterns.
Related
I am building a web API with Servant and Persistent. I plan to define some API endpoints (about 15) that use a connection pool to access the DB.
For example, one of the endpoint definitions (Handlers) is:
getUser :: ConnectionPool -> Int -> Handler User
getUser pool uid = do
user <- inPool pool $ get (toId #User uid)
user & orErr err404 {errBody = "This user does not exist."}
where inPool is just a lifted withResource function, and orErr is a lifted fromMaybe.
Then, a higher level API definition (Servers) looks like this:
type Point (s :: Symbol) (a :: *) =
s :> Capture "id" Int :>
( Get '[JSON] a
:<|> ReqBody '[JSON] a :> Post '[JSON] NoContent
)
type UserPoint = Point "users" User
userServer :: ConnectionPool -> Server UserPoint
userServer pool uid =
getUser pool uid :<|>
postUser pool uid
And I defined the main to be:
main = runStdoutLoggingT . withPostgresqlPool connectionString numConnections $ \pool -> do
withResource pool (runSqlConn $ runMigration migrateAll)
liftIO $ run appPort (userServer pool)
But I soon noticed that I would have to pass the pool down layer by layer (In the example above there are 2 layers, and in my real project there are 3), to every function (that is over 20). My intuition tells me this is bad smell, but I am not quite sure.
Then I thought of ReaderT, because I think that may abstract the pool out. But my concern is that the introduction of ReaderT may lead to unnecessary complexity:
I need to lift many things manually;
The mental model of types will become more complicated thus harder to think about;
It means I'll have to give up the Handler type, which makes using Servant harder too.
I am not sure whether I should use ReaderT in this case. Please offer some suggestions (I'll be grateful if you could also provide some guidelines about when to use ReaderT or even other monad transformers).
UPDATE: I found that I can use where-clauses to simplify this a lot, and this basically solves my problem. but I'm not sure if this is best practice, so I'm still looking forwand to an answer.
userServer :: Pooled (Server UserPoint)
userServer pool auth = c :<|> rud where
c :: UserCreation -> Handler NoContent
c = undefined
rud uid = r :<|> u :<|> d where
r :: Handler User
r = do
checkAuth pool auth
user <- inPool pool $ get (toId #User uid)
user & orErr err404 {errBody = "This user does not exist."}
u :: User -> Handler NoContent
u = undefined
d :: Handler NoContent
d = undefined
While defining your handlers along with your server will avoid you the parameter-passing, as the server grows in complexity you might want to define some handlers separately:
Perhaps some handler provides some generic functionality and could be useful in other servers.
Defining everything together means everything is aware of everything else.
Moving handlers to the top level, or even to another module, will
help make explicit which parts of the whole they really need to know.
And this can make the handler easier to understand.
Once we separate a handler, supplying it with the environment will become necessary. This can be done with plain parameters to functions, or with a ReaderT. As the number of parameters grows, the ReaderT (often in combination with auxiliary HasX typeclasses) becomes more attractive because it frees you from having to care about parameter order.
I would have to pass the pool down layer by layer (In the example
above there are 2 layers, and in my real project there are 3), to
every function
Besides the extra (possibly inevitable) burden of having to pass parameters, I think there's a potentially worse problem lurking: you are threading a low-level detail (the connection pool) through several layers of functions. This can be bad because:
You are committing your whole application to using an actual database. What happens if, during testing, you want switch it with some kind of in-memory repository?
If you need to change the way you do persistence, the refactor will reverberate through all the layers of your application, instead of remaining localized.
One possible solution for these problems: the functions at layer N+1 should not receive as parameter the connection pool, but rather the functions they use from layer N. And those functions from layer N will already have been partially applied with the connection pool.
A trivial example: if you have some high level logic transferUser :: Conn -> Handle -> IO () that includes hardwired calls to functions readUserFromDb :: Conn -> IO User and writeUserToFile :: Handle -> User -> IO (), change it into a transferUser :: IO User -> (User -> IO) -> IO ().
Notice that the auxiliary functions from level N could be stored in the ReaderT context; the functions from level N+1 could get them from there.
It means I'll have to give up the Handler type, which makes using
Servant harder too.
You can define your server using a ReaderT transformer over Handler, and then pass it to the hoistServer function which will "whittle it down" to a runnable server:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
import Servant
import Servant.API
import Control.Monad.Trans.Reader
type UserAPI1 = "users" :> Capture "foo" Int :> Get '[JSON] Int
data Env = Env
-- also valid type
-- server1 :: Int -> ReaderT Env Handler Int
server1 :: ServerT UserAPI1 (ReaderT Env Handler)
server1 =
\ param ->
do _ <- ask
return param
-- also valid types:
-- server2 :: ServerT UserAPI1 Handler
-- server2 :: Int -> Handler Int
server2 :: Server UserAPI1
server2 = hoistServer (Proxy :: Proxy UserAPI1) (flip runReaderT Env) server1
Visualize a bytestring body on a webserver run on Spock (localhost for instance)
My goal : create website and view a bytestring (converted to text)
Framework: Http Simple for performing request to restAPI
Spock for my server
I don't want for instance to create a JSON as I need to manipulate/inspect my response before creating a JSON structure. General idea is that I want to use the response body to construct a JSON query structure (the user will be able to compose his question) that will be sent to the restAPI website.
I manage to build a request like this:
connect = do
request' <- (parseRequest "http://localhost")
let request = setRequestMethod "POST"
$ setRequestHost (S8.pack ("xx.xxx.xxx.xxx"))
$ setRequestPath "/api/Integration/Login"
$ setRequestBodyJSON me
$ setRequestPort 1000
$ request'
response <- httpJSON request
return (getResponseBody response :: Auth)
then I used it to query the API page
getRequest :: RequestPath -> HtmlT IO L.ByteString
getRequest rpath = do
atoken <- liftIO connect
request' <- liftIO (parseRequest "http://localhost")
let request = setRequestMethod "POST"
$ setRequestHost (S8.pack ("xx.xxx.xxx.xxx"))
$ setRequestPort 1000
$ setRequestPath (S8.pack ("/api/Integration/" ++ rpath))
$ addRequestHeader hAuthorization (S8.pack (unpack (token_type (atoken)) ++ " " ++ unpack (access_token (atoken))))
$ setRequestBodyJSON r1
$ request'
response <- httpLBS request
return (getResponseBody (response))
then I follow with a short SpockM monad:
app1 = do get root $ text "root"
fct
with fct equal to
fct = do get "/further" $ lucidIO ( fmap TL.decodeUtf8 (getRequest "GetProperties"))
Everything compile fine I am even able to see the result in GHCI with invocation like : connect >>= (\ x -> print x) (same with getRequest "GetProperties" )
What I don't understand is that lucidIO should give me a ActionCtxtT ctx m b type, which perfectly fit the type of a handler (for example like the text function in the do get ... $ text -> ActionCtxT ctx m a) and should be processed by the spock function in main() ie runSpock 8080 (spock spockCfg app1)
I tried to get rid of the ByteString 'ending' type replacing it with a () in order to mimic as close as possible the Html () type which shows up and work in lot of examples I studied.
All parsing and request building is done with the HTTP.Simple (it's not very elegant I know for instance it just have to work) which pulls me from start in a monad (due to the first function 'parseRequest' -> m Request) from which I cannot escape until lucidIO - may be I am choosing the wrong Monad (ie IO : but with IO I am able to check everything in ghci). Could you give me some hints on how to get this ByteString printed in my browser?
So finally I achieve what I was looking for - woua I am really proud of me ...
Okay for those who will look for the same thing, what I've manage to do, to recap my main problem was to escape the IO monad (my choice may be not clever but still) in which I was stuck due to the use of request parsers from HTTP.simple library.
My code change a little bit but the general idea stays the same:
building a Response query:
getResponseMethod :: RequestPath -> RequestBody -> IO (Maybe Value)
from which thanks to the decode function (aeson package) a Maybe Value is obtained (wrapped in IO but that's okay)
then my little spock server:
main :: IO ()
main = do
spockCfg <- defaultSpockCfg () PCNoDatabase ()
runSpock 8080 (spock spockCfg app)
I work a lot to have the right app -> SpockM () () () ()
I started with the simplest app we could imagine:
app = do get root $ text "Hello!"
noticing that the text function is producing a MonadIO m => ActionCtxT cxt m a monad so my thought was that if I 'sprinkle' some clever LiftIO thing it should do the job.
I create a helper function:
extrct :: MonadIO m => ActionCtxT ctx m Text
extrct = liftIO $ do
a <- getResponseMethod "GetProperties" r1
return (pack $ show a)
and with a twist of hand adjust my app
app :: SpockM () () () ()
app = do get root $ do
a <- extrct
text a
and finally I was able to see the string representation of the Maybe Value :: JSON on my spock local webserver. That's what I was looking for. Now I can work on cleaning my code. From what I understand using liftIO will place the IO monad in the rigth place in the Monad Stack that's because IO is always at the bottom?
What I'm trying to do is to create a somewhat smart reverse proxy server that should process some requests on its own and forward the others to the backend of choice. To make it challenging I'm trying hard to do it in Haskell, which I am a total newbie in.
Here's the code I've come up so far:
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Data.ByteString
import Network.HTTP.ReverseProxy
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger
import qualified Network.HTTP.Client as HC
helloApp :: Application
helloApp req respond =
respond $ responseLBS status200 [("Content-Type", "text/plain")] "Hello"
proxyStubApp :: Application
proxyStubApp req respond =
respond $ responseLBS status200 [("Content-Type", "text/plain")] "You've hit the stub"
proxyApp :: IO Application
proxyApp = do
manager <- HC.newManager HC.defaultManagerSettings
return $ waiProxyTo (const $ return $ WPRProxyDest ProxyDest { pdHost = "localhost", pdPort = 9393 }) defaultOnExc manager
app :: Application
app req respond =
serve req respond
where serve = lookupServeFunction req
lookupServeFunction :: Request -> Application
lookupServeFunction req
| isInfixOf "sample_path" (rawPathInfo req) = proxyStubApp
| otherwise = helloApp
main = run 3011 =<< (logStdoutDev <$> return app)
It works fine, but when I exchange proxyStubApp for actual proxyApp I am forced to add IO all over the place. Particularly it gets added to app, consequently leaving me with the following compilation error message:
Couldn't match expected type ‘Request -> t5 -> t4’
with actual type ‘IO Application’
The equation(s) for ‘app’ have two arguments,
but its type ‘IO Application’ has none
I feel like I understand why it is happening, but I'm out of ideas of how to cope with it :( Or am I doing something totally wrong?
Thank you!
P.S. Here are the dependencies should you want to compile the thing on your own: wai warp http-types text bytestring wai-extra time http-reverse-proxy http-client
The IO in IO Application is kind-of redundant. Note that
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
so, expanding proxyApp's arguments (what you already do in proxyStubApp), you get
proxyApp :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
proxyApp req continuation = do
manager <- HC.newManager HC.defaultManagerSettings
waiProxyTo (...) req respond
That works, because in either case
proxyApp :: IO Application
proxyApp = do
manager <- HC.newManager ...
...
and
proxyApp :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
proxyApp req continuation = do
manager <- HC.newManager ...
...
the IO action HC.newManager ... is "run within IO".
You may find it conceptually clearer to construct an Application in IO and hand it to some other place, and I won't argue with you. I want to note though, that you choose the Application based on the Request, so in a way you are in the hypothetical HTTP monad when choosing, so lookupServeFunction's signature Request -> Application makes more sense to me.
If you want to keep that type signature for proxyApp,
lookupServeFunction and app will have to be in IO as well and main will have to change accordingly, e.g.
myApp <- app
...
As haoformayor said, It is generally easier to work without the outer IO layer.
You might also like to simplify main.
fmap logStdoutDev (return app)
is the same as
return (logStdoutDev app)
and
run 3011 =<< return (logStdoutDev app)
is the same as
run 3011 (logStdoutDev app)
You might want to install hlint, which will help you spot these.
I have a few functions (some of them are nested) in the do block, which have a shared object (for example, a user session):
main = do
session <- establishConnection
user <- getUser
firstFunction user session
secondFunction session
firstFunction user session = do
options <- getOptions
nestedFunction options session
I want to avoid a many duplicated arguments in the functions, so how can I pass a session object into the firstFunction/secondFunction/nestedFunction without a function argument usage? E.g.:
main = do
session <- establishConnection
user <- getsUser
firstFunction user
firstFunction user = do
session <- someMagic
....
Depending on if your functions will change or not the "shared object" you can use a Reader monad or a State monad. The first one in case the "shared object" is read-only, the second one if you want to read and modify the "shared object". I'm going to do an example with the Reader because it is easier:
import Control.Monad.Reader
data Config = Config {
user :: String
, session :: Session
}
type ConnectionState a = ReaderT Config IO a
firstFunction :: ConnectionState ()
firstFunction = do
conf <- ask
-- do something with conf
return ()
secondFunction :: ConnectionState ()
secondFunction = do
conf <- ask
-- do something with conf
return ()
realMain :: ConnectionState ()
realMain = do
firstFunction
secondFunction
main :: IO ()
main = do
conn <- establishConnection
user <- getUser
runReaderT realMain (Config user conn)
The Config data type is the information that you want to pass to the functions, feel free to add or delete fields there. The ConnectionState is the Reader monad that you will use to "share" the Config. It basically encapsulate Config in a "read-only container". Every function has type ConnectionState and can use the function ask to read the Config from the monad. Note that in my example every function has type ConnectionState () but you
The main function is used to create a Config and then to call realMain with it. realMain calls all the functions involved in your program that need the Config.
EDIT: note that if you don' want user in your shared object but as argument of firstFunction you can remove it from Config and change the type of firstFunction to firstFunction :: String -> ConnectionState ()
There are two ways.
The first is probably the more accepted of the two but it is also more complicated. You use a state monad (or if you don't need to modify session a Reader monad). Since you are working in IO you need monad transformation as well to stack the two of them together.
http://en.wikibooks.org/wiki/Haskell/Monad_transformers
The library to use is called (mtl).
The type of your functions will become:
firstFunction :: User -> ReaderT Session IO returntype
If you use this a lot in your project you can make a type synonym
type MyMonad a = ReaderT Session IO a
your someMagic function will be ask
firstFunction user = do
session <- ask
the backdraw of this is that since the outermost monad is ReaderT if you want to perform IO, you have to lift it. This is best achieved using the liftIO function. However you don't need to do anything to run a third function of the same monad.
firstFunction user = do
session <- ask
liftIO (do some io)
thirdFunction
of course you need to specify the session when you first run your monad
main = do
session <- establishConnection
flip runReader session $ do
firstFunction
secondFunction
The second ways is sort of a hack
http://www.haskell.org/haskellwiki/Top_level_mutable_state
It lets you have global IORef's, which you can access from everywhere. The advantage of this is that you can avoid all the annoying lift functions. The disadvantage is that it's a hack and that it is global :).
A third solution is using closures: make local functions, which use session, with let inside the do-block:
main = do
session <- establishConnection
user <- getUser
let firstFunction = do
options <- getOptions
nestedFunction options session
let secondFunction = do
<...>
firstFunction
secondFunction
I am using the LevelDB library and Snap framework together. I have:
main :: IO ()
main = runResourceT $ do
db <- open "thedb" defaultOptions { createIfMissing = True }
liftIO $ serveSnaplet defaultConfig $ initWeb db
Now in my handler, I'm unsure how to get back to MonadResource IO in order to query the database:
handleWords :: Handler App App ()
handleWords = do
words <- uses thedb $ \db -> $ get db def "words"
writeBS $ pack $ show words
Which gives me a: No instance for (MonadResource IO) arising from a use of 'get'
Any ideas? I feel like I'm missing something about how to properly create a monad "stack". Thanks
MonadResource/ResourceT is one way of acquiring scarce resources in a way that guarantees resources will be freed in the case of an exception. Another approach is the bracket pattern, which is supported by Snap via the bracketSnap function. You can use this to create the ResourceT context needed by LevelDB:
import qualified Control.Monad.Trans.Resource as Res
bracketSnap Res.createInternalState Res.closeInternalState $ \resState -> do
let openAction = open "thedb" defaultOptions { createIfMissing = True }
db <- Res.runInternalState openAction resState
This could be made simpler with some changes in Snap and leveldb:
Instead of only providing the open function, which presumes a MonadResource context, there could be a function which returns a Resource value. I'm making this tweak in persistent for the 2.0 release.
Snap could provide support for either MonadResource or the Resource monad (two separate concepts with unfortunately similar names).
Snap doesn't need to support MonadResource or Resource for you to do this. You're doing the monad transformer composition in the wrong direction. A look at the types will help.
serveSnaplet :: Config Snap AppConfig -> SnapletInit b b -> IO ()
runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a
So you're trying to put an IO in the place that a ResourceT is expected. You should approach this the other way around. Put your open "thedb" ... call inside your application's Initializer with a liftIO. But open is a MonadResource, so you need to use the ResourceT instance to get it into an IO. It will look something like this:
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
...
db <- liftIO $ runResourceT $ open "thedb" defaultOptions
Then store the db handle in your App state and you can retrieve it later using Handler's MonadReader or MonadState instances.