Haskell: Making Snap and LevelDB play nice - haskell

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.

Related

Print bytestrings on Spock Web Server

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?

Combining Persistents SqlPersistT with Servants Handler

I'm trying to define a helper function that will allow me to run queries using a connection pool provided when run in the Reader monad. I would like to define a function that will abstract away the asks part of fetching the pool, like so:
type Config = Config { getPool :: ConnectionPool }
type App = ReaderT Config
runQuery :: MonadBaseControl IO m => SqlPersistT m a -> App m a
runQuery query =
asks getPool >>= lift . runSqlQuery
Though I am having trouble getting this to compile... I could have sworn this code had worked on a previous project, and low and behold it had. When I went to look at the definitions of Handler (the m I want in App m), and runSqlQuery they both differ. It seems that Handler has an instance for MonadBaseControl IO m whereas runSqlQuery uses MonadUnliftIO, however, looking back to the change prior to when MonadUnliftIO was added, runSqlQuery used MonadBaseControl IO m... which I presume is why my previous code worked in this instance.
So I suppose my question is, how can I change my implementation of runQuery to support the fact that runSqlQuery is based off of MonadUnliftIO now? I had a look through the functions MonadUnliftIO provides (namely unliftIO) but I have been unable to figure out a way to make the types fit.
It seems this may be an intentional design descision of MonadUnliftIO, looking at the readme here https://www.stackage.org/package/unliftio under 'Limitations' it states that it does not support "Transformers with multiple exit points (e.g., ExceptT)", and Servant's Handler is a wrapper around ExceptT. I may just need to find another way of writing this code.
This compiles with persistent-2.8.2:
runQuery :: MonadUnliftIO m => ReaderT SqlBackend m b -> App m b
runQuery query =
asks getPool >>= lift . runSqlPool query

Avoid `unsafePerformIO` for interaction in a Process Monad

I am using Cloud Haskell for message processing. I am also using a general monad transformer stack (with IO at the bottom) for some general tracking of state, configuration etc.
I am running into a situation where I have to use unsafePerformIO for working inside the Process monad. I am describing the situation below. Please bear in mind this is a much contrived example to simplify and present the crux of the problem
data AppConfig
data AppState
type App = ReaderT AppConfig (StateT AppState IO)
runApp :: App a -> Int -> IO (a, AppState)
runApp k maxDepth =
let config = AppConfig maxDepth
state = AppState 0
in runStateT (runReaderT k config) state
msgHandler :: App ()
msgHandler = -- some message handling logic here --
runServer :: Process ()
runServer = do
let run handler = return $ unsafePerformIO $ runApp handler
(_,_) <- receiveWait [match $ run taskSubmissionHandler]
runServer
Can this unsafePerformIO be somehow avoided? I understand that the Process monad itself is just a wrapper around the IO monad but there are certain IO operations which are essential inside my transformer stack, which cannot be avoided.
Yes, sure. Process is an instance of MonadIO, so you can just
let run = liftIO . runApp
instead.

Catching an Exception from runDb

This is a follow-up to my previous post. MaybeT and Transactions in runDb
I thought this will be a simple thing to do but I have been trying to figure this out for over a day and still haven't made much progress. So thought I will give up and ask!
I just added a try function (from Control.Exception.Lifted) to my previous code and I couldn't get the code to type check. Variants like catch and handle had similar issues.
eauth <- LiftIO (
try( runDb $ do
ma <- runMaybeT $ do
valid <- ...
case ma of
Just a -> return a
Nothing -> liftIO $ throwIO MyException
) :: IO (Either MyException Auth)
)
case eauth of
Right auth -> return auth
Left _ -> lift $ left err400 { errBody = "Could not create user"}
My runDb looks like this (I also tried a variant where I removed liftIO):
runDb query = do
pool <- asks getPool
liftIO $ runSqlPool query pool
I get this error:
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
arising from a use of ‘runDb’
In the expression: runDb
In the first argument of ‘try’, namely
‘(runDb
$ do { ma <- runMaybeT ...
I am running inside servant handler and my return type is AppM Auth where
type AppM = ReaderT Config (EitherT ServantErr IO)
I have tried many combinations of lifting but doesn't seem to be helping. I thought I will take this opportunity to figure out things from scratch and I hit a wall as well. If someone could suggest how you arrived at the answer, it will be super instructive for me.
This has been my thought process:
I see runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a
So that seems to imply it will be in the IO monad, which means try should work
I think check the definition of MonadBaseControl which has class MonadBase b m => MonadBaseControl b m | m -> b. At this point I am confused. This functional dependency logic seems to be suggest type m dictates what b will be but in the previous one b was specified as IO.
I check MonadBase and that did not give me any clue either.
I check SqlPersistT and got no clues either.
I reduced the problem to something very simple like result <- liftIO (try (evaluate (5 `div` 0)) :: IO (Either SomeException Int)) and that worked. So I was even more confused at this time. Doesn't runDb work in IO so shouldn't the same thing work for my original code?
I thought I can figure this out by backtracking but it seems like my level of Haskell knowledge is just not sufficient to get at the root of the problem. Appreciate if people can provide step by step pointers as to arrive at the right solution.
Thanks!
General type signature for try:
(MonadBaseControl IO m, Exception e) => m a -> m (Either e a)
Specialized type signature for try (as it appears in your code):
IO Auth -> IO (Either MyException Auth)
So, the monadic value that is the argument to try has type:
IO Auth
Everything listed above, you probably already understood. If we look at the type signature for your runDb, we get this:
runDb :: (MonadReader Config m, MonadIO m) => SqlPersistT m a -> m a
I sort of had to guess because you didn't provide a type signature, but that is probably what it is. So now, the problem should be a little clearer. You are trying to use runDb to create a monadic value for something that's supposed to be in IO. But IO doesn't satisfy the MonadReader Config instance that you need.
To make the mistake more clear, let's make runDb more monomorphic. You could give it this type signature instead:
type AppM = ReaderT Config (EitherT ServantErr IO)
runDb :: SqlPersistT AppM a -> AppM a
And now if you tried to compile your code, you would get an even better error. Instead of telling you
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
It would tell you that IO doesn't match AppM (although it would probably expand the type synonym). Practically, what this means is that you can't get the shared pool of database connections magically out of IO. You need the ReaderT Config that was passing it around everywhere.
The easiest fix I can think of would be to stop using exceptions where they aren't necessary:
mauth <- runDb $ runMaybeT $ do
... -- Same stuff you were doing earlier
case mauth of
Just auth -> return auth
Nothing -> lift $ left err400 { errBody = "Could not create user"}

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.

Resources