I have written this ManagerSettings to log all requests and responses for my http-conduit application. (By the way, I am importing ClassyPrelude).
tracingManagerSettings :: ManagerSettings
tracingManagerSettings =
tlsManagerSettings { managerModifyRequest = \req -> do
putStr "TRACE: "
print req
putStrLn ""
pure req
, managerModifyResponse = \r -> do
responseChunks <- brConsume $ responseBody r
let fullResponse = mconcat responseChunks
putStr "TRACE: RESPONSE: "
putStrLn $ decodeUtf8 fullResponse
pure $ r { responseBody = pure fullResponse }
}
However, it's not working - when I use it, the application is hanging and trying to consume all the RAM in the machine after printing the first request and first response, which suggests some kind of infinite loop.
Also, the request is printed twice.
I made a previous attempt that was similar, but didn't modify r. That failed because after I had already read the response completely, there was no more response data to read.
If I replace this with tlsManagerSettings, http-conduit works again.
My application is using libstackexchange, which I have modified to allow the ManagerSettings to be customised. I am using http-conduit version 2.2.4.
How can I diagnose the issue? How can I fix it?
managerModifyResponse doesn't work with a Response ByteString, it works with a Response BodyReader, where type BodyReader = IO ByteString along with the contract that if it produces a non-empty ByteString there is more input that can be read.
The problem you're running into is that pure fullResponse never returns an empty ByteString unless it always does. You need to provide a somewhat more complex IO action to capture the intended behavior. Maybe something along these lines (untested):
returnOnce :: Monoid a => a -> IO (IO a)
returnOnce x = do
ref <- newIORef x
pure $ readIORef ref <* writeIORef ref mempty
As for how to debug this? Not sure about generic methods. I was just suspicious that you probably needed a solution along these lines, and the docs for BodyReader confirmed it.
Related
I'm currently trying to implement a simple web server with servant. At the moment, I have a IO (Maybe String) that I want to expose via a GET endpoint (this might be a database lookup that may or may not return a result, hence IO and Maybe). If the Maybe contains a value, the response should contain this value with a 200 OK response status. If the Maybe is Nothing, a 404 Not Found should be returned.
So far I was following the tutorial, which also describes handling errors using throwError. However, I haven't managed to get it to compile. What I have is the following code:
type MaybeAPI = "maybe" :> Get '[ JSON] String
server :: Server MaybeAPI
server = stringHandler
maybeAPI :: Proxy MaybeAPI
maybeAPI = Proxy
app :: Application
app = serve maybeAPI server
stringHandler :: Handler String
stringHandler = liftIO $ fmap (\s -> (fromMaybe (throwError err404) s)) ioMaybeString
ioMaybeString :: IO (Maybe String)
ioMaybeString = return $ Just "foo"
runServer :: IO ()
runServer = run 8081 app
I know this is probably more verbose than it needs to be, but I guess it can be simplified as soon as it is working. The problem is the stringHandler, for which the compilation fails with:
No instance for (MonadError ServerError []) arising from a use of ‘throwError’
So my question is: Is this the way to implement such an endpoint in Servant? If so, how can I fix the implementation? My Haskell knowledge is rather limited and I never used throwError before, so it's entirely possible that I'm missing something here. Any help is appreciated!
As I mentioned in my comment, the problem is that in the offending line:
stringHandler :: Handler String
stringHandler = liftIO $ fmap (\s -> (fromMaybe (throwError err404) s)) ioMaybeString
s is a Maybe String, so to use it as the second argument to fromMaybe, the first argument must be a String - and throwError is never going to produce a string.
Although you talked about your code perhaps being too verbose and you would look at simplifying it later, I think part of the problem here is that in this particular handler you are trying to be too concise. Let's try to write this in a more basic, pseudo-imperative style. Since Handler is a monad, we can write this in a do block which checks the value of s and takes the appropriate action:
stringHandler :: Handler String
stringHandler = do
s <- liftIO ioMaybeString
case s of
Just str -> return str
Nothing -> throwError err404
Note that throwError can produce a value of type Handler a for any type it needs to be, which in this case is String. And that we have to use liftIO on ioMaybeString to lift it into the Handler monad, else this won't typecheck.
I can understand why you might have thought fromMaybe was a good fit here, but fundamentally it isn't - the reason being that it's a "pure" function, that doesn't involve IO at all, whereas when you're talking about throwing server errors then you are absolutely unavoidably doing IO. These things essentially can't mix within a single function. (Which makes the fmap inappropriate too - that can certainly be used to "lift" a pure computation to work on IO actions, but here, as I've said, the computation you needed fundamentally isn't pure.)
And if you want to make the stringHandler function above more concise, while I don't think it's really an improvement, you could still use >>= explicitly instead of the do block, without making the code too unreadable:
stringHandler = liftIO ioMaybeString >>= f
where f (Just str) = return str
f Nothing = throwError err404
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?
I'm retrieving data from a database using HDBC, then trying to send this data to a web client using Happstack.
myFunc :: Integer -> IO String
myFunc = ... fetch from db here ...
handlers :: ServerPart Response
handlers =
do decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
msum [
dir "getData" $ ok $ toResponse $ myFunc $ toInteger 1
]
mainFunc = simpleHTTP nullConf handlers
When I build the above code I get this error:
No instance for (ToMessage (IO String)) arising from a use of
`toResponse'
What did I try ?
I tried to convert the IO String to String (using liftIO for example).
I tried to find any similar questions here.
I tried to find a similar example in the Happstack Crash Course.
I googled all related keywords in all different combinations.
Thanks in advance.
You have to design your handlers around the fact that fetching from a database is a magical action that may not give you what you expect. (For example, your database may crash.) This is why its result is served as an IO, which is a particular case of a monad.
A monad is a jar with a very narrow neck, so narrow even that, once you put something in there, you cannot unput it. (Unless it happens to also be a comonad, but that's a whole another story and not the case with IO nor with ServerPart.) So, you would never convert an IO String to a String. Not that you can't, but your program would become incorrect.
Your case is kind of tricky as you have two monads at play there: IO and ServerPart. Fortunately, ServerPart builds upon IO, it is " larger " and can, in a sense, absorb IO: we can put some IO into a ServerPart and it will be a ServerPart still, so we may then give it to simpleHTTP. In happstack, this conversion may be done via require function, but there is a more general solution as well, involving monad transformers and lift.
Let's take a look at the solution with require first. Its type (simplified to our case) is:
IO (Maybe a) -> (a -> ServerPart r) -> ServerPart r
— So, it takes an IO jar with some argument and makes it suitable for a function that lives in the ServerPart jar. We just have to adjust types a bit and create one lambda abstraction:
myFunc :: Integer -> IO (Maybe String)
myFunc _ = return . Just $ "A thing of beauty is a joy forever."
handlers :: ServerPart Response
handlers = require (myFunc 1) $ \x ->
do decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
msum [
dir "getData" $ ok $ toResponse x
]
mainFunc = simpleHTTP nullConf handlers
As you see, we have to make 2 modifications:
Adjust myFunc so that it returns Maybe, as necessitated by require. This is a better design because myFunc may now fail in two ways:
As a Maybe, it may return Nothing, which means 404 or the like. This is rather common a situation.
As an IO, it may error out, which means the database crashed. Now is the time to alert the DevOps team.
Adjust handlers so that myFunc is external to them. One may say more specifically: abstract myFunc from handlers. This is why this syntax is called a lambda abstraction.
require is the way to deal with monads in happstack specifically. Generally though, this is just a case of transforming monads into larger ones, which is done via lift. The type of lift (again, simplified), is:
IO String -> ServerPart String
So, we can just lift the myFunc 1 :: IO String value to the right monad and then compose with >>=, as usual:
myFunc :: Integer -> IO String
myFunc _ = return $ "Its loveliness increases,.."
handlers :: ServerPart Response
handlers = lift (myFunc 1) >>= \x ->
do decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
msum [
dir "getData" $ ok $ toResponse x
]
mainFunc = simpleHTTP nullConf handlers
As simple as that. I used the same lambda abstraction trick again, but you may as well use do-notation:
myFunc :: Integer -> IO String
myFunc _ = return $ "...it will never pass into nothingness."
handlers :: ServerPart Response
handlers = do
x <- lift (myFunc 1)
decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
msum [
dir "getData" $ ok $ toResponse x
]
mainFunc = simpleHTTP nullConf handlers
P.S. Returning to the story of large and small jars: you can put IO into ServerPart precisely because ServerPart is also an IO monad — it is an instance of the MonadIO class. That means that anything you can do in IO you can also do in ServerPart, and, besides general lift, there is a specialized liftIO function that you can use everywhere I used lift. You are likely to meet many other monads out there that are instances of MonadIO as it's a handy way of structuring code in large applications.
In your particular case, I would stick with the require way nevertheless because I think it's how the designers of happstack meant it to be done. I'm not particularly knowledgeable about happstack though, so I may be wrong.
That's it. Happy hacking!
I wonder how I/O were done in Haskell in the days when IO monad was still not invented. Anyone knows an example.
Edit: Can I/O be done without the IO Monad in modern Haskell? I'd prefer an example that works with modern GHC.
Before the IO monad was introduced, main was a function of type [Response] -> [Request]. A Request would represent an I/O action like writing to a channel or a file, or reading input, or reading environment variables etc.. A Response would be the result of such an action. For example if you performed a ReadChan or ReadFile request, the corresponding Response would be Str str where str would be a String containing the read input. When performing an AppendChan, AppendFile or WriteFile request, the response would simply be Success. (Assuming, in all cases, that the given action was actually successful, of course).
So a Haskell program would work by building up a list of Request values and reading the corresponding responses from the list given to main. For example a program to read a number from the user might look like this (leaving out any error handling for simplicity's sake):
main :: [Response] -> [Request]
main responses =
[
AppendChan "stdout" "Please enter a Number\n",
ReadChan "stdin",
AppendChan "stdout" . show $ enteredNumber * 2
]
where (Str input) = responses !! 1
firstLine = head . lines $ input
enteredNumber = read firstLine
As Stephen Tetley already pointed out in a comment, a detailed specification of this model is given in chapter 7 of the 1.2 Haskell Report.
Can I/O be done without the IO Monad in modern Haskell?
No. Haskell no longer supports the Response/Request way of doing IO directly and the type of main is now IO (), so you can't write a Haskell program that doesn't involve IO and even if you could, you'd still have no alternative way of doing any I/O.
What you can do, however, is to write a function that takes an old-style main function and turns it into an IO action. You could then write everything using the old style and then only use IO in main where you'd simply invoke the conversion function on your real main function. Doing so would almost certainly be more cumbersome than using the IO monad (and would confuse the hell out of any modern Haskeller reading your code), so I definitely would not recommend it. However it is possible. Such a conversion function could look like this:
import System.IO.Unsafe
-- Since the Request and Response types no longer exist, we have to redefine
-- them here ourselves. To support more I/O operations, we'd need to expand
-- these types
data Request =
ReadChan String
| AppendChan String String
data Response =
Success
| Str String
deriving Show
-- Execute a request using the IO monad and return the corresponding Response.
executeRequest :: Request -> IO Response
executeRequest (AppendChan "stdout" message) = do
putStr message
return Success
executeRequest (AppendChan chan _) =
error ("Output channel " ++ chan ++ " not supported")
executeRequest (ReadChan "stdin") = do
input <- getContents
return $ Str input
executeRequest (ReadChan chan) =
error ("Input channel " ++ chan ++ " not supported")
-- Take an old style main function and turn it into an IO action
executeOldStyleMain :: ([Response] -> [Request]) -> IO ()
executeOldStyleMain oldStyleMain = do
-- I'm really sorry for this.
-- I don't think it is possible to write this function without unsafePerformIO
let responses = map (unsafePerformIO . executeRequest) . oldStyleMain $ responses
-- Make sure that all responses are evaluated (so that the I/O actually takes
-- place) and then return ()
foldr seq (return ()) responses
You could then use this function like this:
-- In an old-style Haskell application to double a number, this would be the
-- main function
doubleUserInput :: [Response] -> [Request]
doubleUserInput responses =
[
AppendChan "stdout" "Please enter a Number\n",
ReadChan "stdin",
AppendChan "stdout" . show $ enteredNumber * 2
]
where (Str input) = responses !! 1
firstLine = head . lines $ input
enteredNumber = read firstLine
main :: IO ()
main = executeOldStyleMain doubleUserInput
I'd prefer an example that works with modern GHC.
For GHC 8.6.5:
import Control.Concurrent.Chan(newChan, getChanContents, writeChan)
import Control.Monad((<=<))
type Dialogue = [Response] -> [Request]
data Request = Getq | Putq Char
data Response = Getp Char | Putp
runDialogue :: Dialogue -> IO ()
runDialogue d =
do ch <- newChan
l <- getChanContents ch
mapM_ (writeChan ch <=< respond) (d l)
respond :: Request -> IO Response
respond Getq = fmap Getp getChar
respond (Putq c) = putChar c >> return Putp
where the type declarations are from page 14 of How to Declare an Imperative by Philip Wadler. Test programs are left as an exercise for curious readers :-)
If anyone is wondering:
-- from ghc-8.6.5/libraries/base/Control/Concurrent/Chan.hs, lines 132-139
getChanContents :: Chan a -> IO [a]
getChanContents ch
= unsafeInterleaveIO (do
x <- readChan ch
xs <- getChanContents ch
return (x:xs)
)
yes - unsafeInterleaveIO does make an appearance.
#sepp2k already clarified how this works, but i wanted to add a few words
I'm really sorry for this. I don't think it is possible to write this function without unsafePerformIO
Of course you can, you should almost never use unsafePerformIO
http://chrisdone.com/posts/haskellers
I'm using slightly different Request type constructor, so that it does not take channel version (stdin / stdout like in #sepp2k's code). Here is my solution for this:
(Note: getFirstReq doesn't work on empty list, you would have to add a case for that, bu it should be trivial)
data Request = Readline
| PutStrLn String
data Response = Success
| Str String
type Dialog = [Response] -> [Request]
execRequest :: Request -> IO Response
execRequest Readline = getLine >>= \s -> return (Str s)
execRequest (PutStrLn s) = putStrLn s >> return Success
dialogToIOMonad :: Dialog -> IO ()
dialogToIOMonad dialog =
let getFirstReq :: Dialog -> Request
getFirstReq dialog = let (req:_) = dialog [] in req
getTailReqs :: Dialog -> Response -> Dialog
getTailReqs dialog resp =
\resps -> let (_:reqs) = dialog (resp:resps) in reqs
in do
let req = getFirstReq dialog
resp <- execRequest req
dialogToIOMonad (getTailReqs dialog resp)
I'm using http-client tutorial to get response body using TLS connection. Since I can observe that print is called by withResponse, why doesn't print force entire response to the output in the following fragment?
withResponse request manager $ \response -> do
putStrLn $ "The status code was: " ++
body <- (responseBody response)
print body
I need to write this instead:
response <- httpLbs request manager
putStrLn $ "The status code was: " ++
show (statusCode $ responseStatus response)
print $ responseBody response
Body I want to print is a lazy ByteString. I'm still not sure whether I should expect print to print the entire value.
instance Show ByteString where
showsPrec p ps r = showsPrec p (unpackChars ps) r
This doesn't have to do with laziness, but with the difference between the Response L.ByteString you get with the Simple module, and the Response BodyReader you get with the TLS module.
You noticed that a BodyReader is an IO ByteString. But in particular it is an action that can be repeated, each time with the next chunk of bytes. It follows the protocol that it never sends a null bytestring except when it's at the end of file. (BodyReader might have been called ChunkGetter). bip below is like what you wrote: after extracting the BodyReader/IO ByteString from the Response, it performs it to get the first chunk, and prints it. But doesn't repeat the action to get more - so in this case we just see the first couple chapters of Genesis. What you need is a loop to exhaust the chunks, as in bop below, which causes the whole King James Bible to spill into the console.
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import qualified Data.ByteString.Char8 as B
main = bip
-- main = bop
bip = do
manager <- newManager tlsManagerSettings
request <- parseRequest "https://raw.githubusercontent.com/michaelt/kjv/master/kjv.txt"
withResponse request manager $ \response -> do
putStrLn "The status code was: "
print (responseStatus response)
chunk <- responseBody response
B.putStrLn chunk
bop = do
manager <- newManager tlsManagerSettings
request <- parseRequest "https://raw.githubusercontent.com/michaelt/kjv/master/kjv.txt"
withResponse request manager $ \response -> do
putStrLn "The status code was: "
print (responseStatus response)
let loop = do
chunk <- responseBody response
if B.null chunk
then return ()
else B.putStr chunk >> loop
loop
The loop keeps going back to get more chunks until it gets an empty string, which represents eof, so in the terminal it prints through to the end of the Apocalypse.
This is behavior is straightforward but slightly technical. You can only work with a BodyReader by hand-written recursion. But the purpose of the http-client library is to make things like http-conduit possible. There the result of withResponse has the type Response (ConduitM i ByteString m ()). ConduitM i ByteString m () is how conduit types of a byte stream; this byte stream would contain the whole file.
In the original form of the http-client/http-conduit material, the Response contained a conduit like this; the BodyReader part was later factored out into http-client so it could be used by different streaming libraries like pipes.
So to take a simple example, in the corresponding http material for the streaming and streaming-bytestring libraries, withHTTP gives you a response of type Response (ByteString IO ()). ByteString IO () is the type of a stream of bytes arising in IO, as its name suggests; ByteString Identity () would be the equivalent of a lazy bytestring (effectively a pure list of chunks.) The ByteString IO () will in this case represent the whole bytestream down to the Apocalypse. So with the imports
import qualified Data.ByteString.Streaming.HTTP as Bytes -- streaming-utils
import qualified Data.ByteString.Streaming.Char8 as Bytes -- streaming-bytestring
the program is identical to a lazy bytestring program:
bap = do
manager <- newManager tlsManagerSettings
request <- parseRequest "https://raw.githubusercontent.com/michaelt/kjv/master/kjv.txt"
Bytes.withHTTP request manager $ \response -> do
putStrLn "The status code was: "
print (responseStatus response)
Bytes.putStrLn $ responseBody response
Indeed it is slightly simpler, since you don't have "extract the bytes from IO`:
lazy_bytes <- responseStatus response
Lazy.putStrLn lazy_bytes
but just write
Bytes.putStrLn $ responseBody response
you just "print" them directly. If you want to view just a bit from the middle of the KJV, you can instead do what you would with a lazy bytestring, and end with:
Bytes.putStrLn $ Bytes.take 1000 $ Bytes.drop 50000 $ responseBody response
Then you will see something about Abraham.
The withHTTP for streaming-bytestring just hides the recursive looping that we needed to use the BodyReader material from http-client directly. It's the same e.g. with the withHTTP you find in pipes-http, which represents a stream of bytestring chunks as Producer ByteString IO (), and the same with http-conduit. In all of these cases, once you have your hands on the byte stream you handle it in the ways typical of the streaming IO framework without handwritten recursion. All of them use the BodyReader from http-client to do this, and this was the main purpose of the library.