I'm trying to create some middleware that will send 500 errors to a remote server. The error information is in the response body.
How can I get the response body from a Response as any kind of string? I see responseToStream but I can't figure out how to use it.
import Network.Wai
import Data.ByteString.Lazy (ByteString)
responseBody :: Response -> IO ByteString
responseBody res = _
An implementation of the comment by #user2407038:
import Data.IORef (newIORef,modifyIORef',readIORef)
import Data.Monoid ((<>))
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Builder (toLazyByteString)
import Network.Wai
responseBody :: Response -> IO ByteString
responseBody res =
let (status,headers,body) = responseToStream res in
body $ \f -> do
content <- newIORef mempty
f (\chunk -> modifyIORef' content (<> chunk)) (return ())
toLazyByteString <$> readIORef content
Related
I'm testing some HTTP requests in haskell and have the below methods:
import qualified Data.ByteString.Lazy as LAZ
import Language.Haskell.TH.Ppr
import System.IO
import Data.Word (Word8)
request :: IO LAZ.ByteString
request = do
response <- simpleHttp "https://www.url.com"
return (response)
exampleFunctionOne:: IO LAZ.ByteString -> IO LAZ.ByteString
exampleFunctionOne bytes = do
html <- bytes
let bytesToChars = bytesToString $ LAZ.unpack html
let x = exampleFunctionTwo bytesToChars
bytes
exampleFunctionTwo :: [Char] -> [Char]
exampleFunctionTwo chars = --Do stuff...
main = do
exampleFunctionOe $ request
My questions are:
Is there a more straight forward way to convert the ByteString to [Char]? Currently I've having to convert to perform (ByteString -> Word8) and then (Word8 -> Char)
Am I correct in saying the 'return ()' statement in my request function is simply re-applying the monad context (in this case IO) to the value I've extracted (response <- simpleHttp)? Or does it have an additional purpose?
To answer your first question, note that there's a different "unpack" in Data.ByteString.Lazy.Char8 with the signature you want:
unpack :: ByteString -> String
It's not unusual for people to import both modules:
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as C
and mix and match functions from each.
To answer your second question, yes that's more or less it. For example:
redund = do x <- getLine
y <- return x
z <- return y
u <- return z
return u
is all equivalent to redund = getLine with a bunch of re-wrapping and extracting of pure values into an out of an IO monad.
I am trying to create a conduit that will stream data from HTTP through a conduit source. Here is what I have so far:
import qualified Network.HTTP.Client.Conduit as CC
getStream :: String -> IO (ConduitM () BS.ByteString IO ())
getStream url = do
req <- parseUrl url
return $ CC.withResponse req $ \res -> do
responseBody res $= (awaitForever $ \bytes -> liftIO $ do
putStrLn $ "Got " ++ show (BS.length bytes) ++ " but will ignore them")
But I am getting
No instance for (Control.Monad.Reader.Class.MonadReader env0 IO) …
arising from a use of ‘CC.withResponse’
In the expression: CC.withResponse req
In the second argument of ‘($)’, namely
‘CC.withResponse req
$ \ res
-> do { responseBody res $= (awaitForever $ \ bytes -> ...) }’
In a stmt of a 'do' block:
return
$ CC.withResponse req
$ \ res
-> do { responseBody res $= (awaitForever $ \ bytes -> ...) }
How come a MonadReader is expected? It doesn't make any sense to me.
How about this variation of the example in the Network.HTTP.Conduit docs:
{-# LANGUAGE OverloadedStrings #-}
module Lib2 () where
import Data.Conduit (($$+-), awaitForever)
import qualified Network.HTTP.Client.Conduit as CC
import Network.HTTP.Conduit (http, tlsManagerSettings, newManager)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit.Binary (sinkFile) -- Exported from the package conduit-extra
main2 :: IO ()
main2 = do
request <- CC.parseUrl "http://google.com/"
manager <- newManager tlsManagerSettings
runResourceT $ do
response <- http request manager
CC.responseBody response $$+- (awaitForever $ \x -> liftIO $ putStrLn "Chunk")
Original answer
The return type for getStream is wrong. Try removing the type signature and use FlexibleContexts, e.g.:
{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Lib () where
import Data.Conduit
import qualified Data.ByteString as BS
import qualified Network.HTTP.Client.Conduit as CC
import Control.Monad.IO.Class
getStream url = do
req <- CC.parseUrl url
CC.withResponse req $ \res -> do
CC.responseBody res $= (awaitForever $ \x -> liftIO $ putStrLn "Got a chunk")
And then :t getStream reports:
getStream
:: (monad-control-1.0.0.4:Control.Monad.Trans.Control.MonadBaseControl
IO (ConduitM a c m),
mtl-2.2.1:Control.Monad.Reader.Class.MonadReader env m, MonadIO m,
CC.HasHttpManager env,
exceptions-0.8.0.2:Control.Monad.Catch.MonadThrow m) =>
String -> ConduitM a c m ()
which shows that the return type has the form ConduitM ..., not IO ....
This also shows how MonadReader gets into the picture... The monad m must have access to an HTTP manager through a reader environment as expressed by the following constraints:
CC.HasHttpManager env
MonadReader env m
All this is saying is that m has a reader environment of some type env which itself has a way of accessing an HTTP manager.
In particular, m cannot be just the plain IO monad, which is what the error message is complaining about.
Answer to question in the comments
Here is an example of how to create a Producer from a HTTP response:
{-# LANGUAGE OverloadedStrings #-}
module Lib3 () where
import qualified Data.ByteString as BS
import qualified Network.HTTP.Client.Conduit as CC
import Network.HTTP.Conduit (http, tlsManagerSettings, newManager)
import qualified Network.HTTP.Client as Client (httpLbs, responseOpen, responseClose)
import Data.Conduit (Producer, addCleanup)
import Data.Conduit (awaitForever, await, ($$))
import qualified Network.HTTP.Client.Conduit as HCC
import Control.Monad.IO.Class (liftIO, MonadIO)
getStream url = do
request <- CC.parseUrl url
manager <- newManager tlsManagerSettings
response <- Client.responseOpen request manager
let producer :: Producer IO BS.ByteString
producer = HCC.bodyReaderSource $ CC.responseBody response
cleanup _ = do liftIO $ putStrLn "(cleaning up)"; Client.responseClose response
producerWithCleanup = addCleanup cleanup producer
return $ response { CC.responseBody = producerWithCleanup }
test = do
res <- getStream "http://google.com"
let producer = CC.responseBody res
consumer = awaitForever $ \_ -> liftIO $ putStrLn "Got a chunk"
producer $$ consumer
When I run this code, I get a decode error from Data.Text. What am I doing wrong?
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.ByteString (ByteString)
import System.Entropy
randBS :: IO ByteString
randBS = do
randBytes <- getEntropy 2048
return randBytes
main :: IO ()
main = do
r <- randBS
putStrLn $ unpack $ decodeUtf8 r
Runtime Error:
Cannot decode byte '\xc4': Data.Text.Internal.Encoding.Fusion.streamUtf8:
Invalid UTF-8 stream
I would like to generate some random bytes that will be used as an auth token.
I am on Mac OS X (Yosemite) and GHC Version 7.10.1
randBS returns random bytes not utf-8 encoded data!
What you have is not a representation of Text so it doesn't matter which function you use you will encounter some decoding error, and so you'll have to use something like decodeUtf8With and use an error handler to replace invalid bytes with their literal counterpart.
Something like:
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8With)
import Data.ByteString (ByteString)
import Data.Char (chr)
import Control.Applicative ((<$>))
import System.Entropy
handler _ x = chr <$> fromIntegral <$> x
randBS :: IO ByteString
randBS = do
randBytes <- getEntropy 2048
return randBytes
main :: IO ()
main = do
r <- randBS
putStrLn $ unpack $ decodeUtf8With handler r
Not tested, in this moment I don't have GHC installed :s
Probably even better is to simply use hexadecimal encoding instead of utf-8 + error handler. You can do so with the base16-bytestring library. So you'd first use the encode :: ByteString -> ByteString to obtain a representation with only ASCII values:
import Data.Text (Text, pack, unpack)
import Data.ByteString (ByteString)
import Data.ByteString.Encoding (decodeUtf8)
import Data.ByteString.Base16 (encode)
import System.Entropy
--- ... randBS as before
main = do
r <- randBS
putStrLn $ unpack $ decodeUtf8 $ encode r
Continuing my exploration of conduit and aeson, how would I go about using my own data type in stead of Value in this (slightly modified) code snippet from the Yesod book.
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
import Network.Wai (Response, responseLBS, Application, requestBody)
import Network.HTTP.Types (status200, status400)
import Network.Wai.Handler.Warp (run)
import Data.Aeson.Parser (json)
import Data.Conduit.Attoparsec (sinkParser)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value(..), encode, object, (.=))
import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import Data.Conduit (ResourceT, ($$))
import Control.Exception.Lifted (handle)
import qualified Data.HashMap.Strict as M
import Data.Aeson.TH (deriveJSON)
-- I ADDED THIS
data JSONRequest = JSONRequest {
command :: ByteString,
params :: M.HashMap ByteString ByteString
}
deriveJSON id ''JSONRequest
-- END OF WHAT I ADDED
main :: IO ()
main = run 3000 app
app :: Application
app req = handle invalidJson $ do
value <- requestBody req $$ sinkParser json
newValue <- liftIO $ dispatch value
return $ responseLBS
status200
[("Content-Type", "application/json")]
$ encode newValue
invalidJson :: SomeException -> ResourceT IO Response
invalidJson ex = return $ responseLBS
status400
[("Content-Type", "application/json")]
$ encode $ object
[ ("message" .= show ex)
]
-- Application-specific logic would go here.
dispatch :: Value -> IO Value
dispatch = return
Basically, I want to change the type of dispatch to JSONRequest -> IO JSONRequest. How do I tell the parser to use my own derived instance of fromJSON?
I tried just adding a type declaration, praying for polymorphic return type on json, but I realised it is strictly for Value.
Just looking at the types, don't you just need to fmap your fromJSON over the result coming from json? With a suitable signature for dispatch we just need:
-- import Data.Aeson
app :: Application
app req = handle invalidJson $ do
result <- requestBody req $$ sinkParser (fmap fromJSON json)
next_result <- liftIO $ dispatch result
return $ responseLBS status200 [("Content-Type", "application/json")]
$ encode next_result
dispatch :: Result JSONRequest -> IO JSONRequest
dispatch (Error str) = undefined
dispatch (Success jsonreq) = return jsonreq
But maybe it's a little clearer written thus:
-- import Data.Aeson
-- import qualified Data.Attoparsec as Atto
toRequest :: Value -> Result JSONRequest
toRequest = fromJSON -- specialized now to your fromJSON
jsonRequestParser :: Atto.Parser (Result JSONRequest)
jsonRequestParser = fmap toRequest json
app :: Application
app req = handle invalidJson $ do
result <- requestBody req $$ sinkParser jsonRequestParser
next_result <- liftIO $ dispatch result
return $ responseLBS status200 [("Content-Type", "application/json")]
$ encode next_result
dispatch :: Result JSONRequest -> IO JSONRequest
dispatch (Error str) = undefined
dispatch (Success jsonreq) = return jsonreq
I left the parser returning a Result JSONRequest so dispatch is handling Error cases too, which might mean you need your exception handling somehow?
I'm trying to create a JSON REST api using Happstack. It should allow POSTS with a JSON body. How can I do this? All the functions in happstack's API seem to look things up based on parameter name. It thinks the body is always url-encoded.
If it isn't possible with Happstack, which framework should I use?
Alright, here's what I figured out.
{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
import qualified Data.ByteString.Lazy.Char8 as L
import Happstack.Server
import Happstack.Server.Types
import Control.Monad.IO.Class (liftIO)
import Data.Data (Data, Typeable)
-- easiest to serialize/deserialize objects
data Unit = Unit { x :: Int, y :: Int } deriving (Show, Eq, Data, Typeable)
-- put this function in a library somewhere
getBody :: ServerPart L.ByteString
getBody = do
req <- askRq
body <- liftIO $ takeRequestBody req
case body of
Just rqbody -> return . unBody $ rqbody
Nothing -> return ""
myRoute :: ServerPart Response
myRoute = do
body <- getBody -- it's a ByteString
let unit = fromJust $ A.decode body :: Unit -- how to parse json
ok $ toResponse $ A.encode unit -- how to send json back.