I have two http-servers working with a json api using the snap framework
my first prototype contains a handler similar to this example handler
import Data.ByteString (ByteString)
import Data.ByteString.Char8 as B (unwords, putStrLn)
import Data.ByteString.Lazy.Char8 as L (putStrLn)
import Control.Monad.IO.Class (liftIO)
import Data.Monoid ((<>))
import Snap.Core (getParam, modifyResponse, setHeader, writeLBS)
import Network.HTTP.Conduit
import Network.HTTP.Client (defaultManagerSettings)
exampleHandler :: AppHandler ()
exampleHandler = do resp <- liftIO
$ do L.putStrLn "Begin request ..."
initReq <- parseUrl "http://localhost:8001/api"
manager <- newManager defaultManagerSettings
let req = initReq { method = "GET"
, proxy = Nothing}
r <- httpLbs req manager
L.putStrLn "... finished request."
return $ responseBody r
liftIO . L.putStrLn $ "resp: " <> resp
modifyResponse $ setHeader "Content-Type" "application/json"
writeLBS $ "{ \"data\": \""<> resp <>"\" }"
If I issue an ajax-request, the response is sent and received - i see this when the server writes resp: testdata on the console, but the response sent to the browser with writeLBS is not. Now if I change the last line to
writeLBS $ "{ \"data\": \""<> "something fixed" <>"\" }"
everything works like a charm. I think I am meeting one of the pitfalls of lazy IO, but I don't know how to remedy this.
I also tried a few variations with no singe liftIO-block but putting liftIO where necessary.
EDIT
based on the comment by #MichaelSnoyman I did some research regarding writeLBS and tried to
modifyResponse $ setBufferingMode False
. setHeader "Content-Type" "application/json"
writeLBS resp
as I thought maybe buffering could be the problem - no it is not
Furthermore I tried to write explicitly a setResponseBody
let bb = enumBuilder . fromLazyByteString $ "{ \"data\": \""<> resp <>"\" }"
modifyResponse $ setBufferingMode False
. setHeader "Content-Type" "application/json"
. setResponseBody bb
Which showed also no success.
I have solved this issue - it actually was a problem with the javascript getting the handwritten json (note to self: never do that again). There was a non-breaking space at the end of the input data that was not encoded correctly, and I as I am a newbie at JS I didn't get that from the error message.
The intermediate solution is to add urlEncode and make a strict ByteString
let respB = urlEncode . L.toStrict $ C.responseBody resp
modifyResponse $ setBufferingMode False
. setHeader "Content-Type" "application/json"
writeBS $ "{ \"data\": \"" <> respB <> "\" }"
of course you have to change imports accordingly.
The long term solution is: write a proper from/toJSON instance and let the library deal with this.
Related
I was able to successfully use the websockets library with https://www.websocket.org/echo.html. I can also connect to api2.poloniex.com via https://www.websocket.org and successfully query the websocket.
However when I try to connect to api2.poloniex.com with websockets I get the following error:
Exception: MalformedResponse (ResponseHead {responseCode = 403, responseMessage = "Forbidden", responseHeaders = [("Date","Wed, 15 Aug 2018 00:27:10 GMT"),("Content-Type","text/html; charset=UTF-8"),("Transfer-Encoding","chunked"),("Connection","close"),("CF-Chl-Bypass","1"),("Set-Cookie","__cfduid=de2aa54a27d656c35f2c3b90f60cc72461534292830; expires=Thu, 15-Aug-19 00:27:10 GMT; path=/; domain=.poloniex.com; HttpOnly"),("Cache-Control","max-age=2"),("Expires","Wed, 15 Aug 2018 00:27:12 GMT"),("X-Frame-Options","SAMEORIGIN"),("Server","cloudflare"),("CF-RAY","44a788b174052eb7-MIA")]}) "Wrong response status or message."
My code is as follows:
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
) where
import Control.Concurrent (forkIO)
import Control.Monad (forever, unless)
import Control.Monad.Trans (liftIO)
import Data.Aeson
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.Socket (withSocketsDo)
import qualified Network.WebSockets as WS
--------------------------------------------------------------------------------
app :: WS.ClientApp ()
app conn = do
putStrLn "Connected!"
-- Fork a thread that writes WS data to stdout
_ <- forkIO $ forever $ do
msg <- WS.receiveData conn
liftIO $ T.putStrLn msg
-- Read from stdin and write to WS
let loop = do
line <- T.getLine
unless (T.null line) $ WS.sendTextData conn line >> loop
loop
WS.sendClose conn ("Bye!" :: Text)
--------------------------------------------------------------------------------
main :: IO ()
main = withSocketsDo $ WS.runClient "api2.poloniex.com" 80 "" app
It seems like that the Poloniex WebSocket API requires a secure connection, see: https://poloniex.com/support/api/ (I know this from the WS endpoint URL, it uses wss:// instead of ws://). WS.runClient uses the unsecure ws:// protocol instead of the secure wss:// one and thus it won't be able to connect. Try using the wuss library: http://hackage.haskell.org/package/wuss
and rewrite your main function to:
import qualified Wuss as WSS (runSecureClient)
-- ...
main :: IO ()
main = withSocketsDo $ WSS.runSecureClient "api2.poloniex.com" 443 "/" app
Hope this helps!
The issue was for whatever reason my public IP was being blocked. I got around this by using a VPN.
I have following code working with proxy for a GET Request:
import Control.Applicative ((<$>))
import Data.Maybe (fromJust)
import Network.Browser
import Network.HTTP
import Network.HTTP.Proxy (parseProxy)
main = do
rsp <- browse $ do
setProxy . fromJust $ parseProxy "127.0.0.1:8118"
request $ getRequest "http://www.google.com"
print $ rspBody <$> rsp
And this one for Post, but without proxy:
main = do
r <- post "http://www.geocodeip.com" ["IP" := Data.ByteString.Lazy.Char8.pack "79.212.82.103"]
html <- r ^. responseBody
print html
But how to make a post request with proxy? I dont get it. please help me!
It's pretty simple if you keep track of what you're doing.
We need to use request but feed it a POST request rather than a GET request. To make these we use postRequestWithBody which Hackage tells us has the parameters
postRequestWithBody :: String | URL to POST to
-> String | Content-Type of body
-> String | The body of the request
-> Request_String | The constructed request
So replace request $ getRequest "http://www.google.com" with:
request $ postRequestWithBody "http://www.geocodeip.com/" "application/x-www-form-urlencoded" "IP=79.212.82.103"
...and you'll be good.
I'd like to implement streaming of large data (in both directions) with the Snap server. To explore the possibilities I created a sample program that has two endpoints - reading and writing. There is a very simple internal buffer that holds one ByteString and whatever is written to the writing endpoint appears in the reading one. (Currently there is no way how to terminate the stream, but that's fine for this purpose.)
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Concurrent.MVar.Lifted
import Control.Monad
import Data.ByteString (ByteString)
import Blaze.ByteString.Builder (Builder, fromByteString)
import Data.Enumerator
import qualified Data.Enumerator.List as E
import Data.Enumerator.Binary (enumFile, iterHandle)
import Snap.Core
import Snap.Http.Server
main :: IO ()
main = do
buf <- newEmptyMVar
quickHttpServe (site buf)
site :: MVar ByteString -> Snap ()
site buf =
route [ ("read", modifyResponse (setBufferingMode False
. setResponseBody (fromBuf buf)))
, ("write", runRequestBody (toBuf buf))
]
fromBuf :: MVar ByteString -> Enumerator Builder IO a
fromBuf buf = E.repeatM (liftM fromByteString $ takeMVar buf)
toBuf :: MVar ByteString -> Iteratee ByteString IO ()
toBuf buf = E.mapM_ (putMVar buf)
Then I run in different terminals
curl http://localhost:8000/read >/dev/nul
and
dd if=/dev/zero bs=1M count=100 | \
curl --data-binary #- http://localhost:8000/write
But the writing part fails with an exception escaped to toplevel: Too many bytes read. This is obviously an instance of TooManyBytesReadException, but I couldn't find where it's thrown. Writing smaller amount of data like 1MB works as expected.
My questions are:
Where/how to fix the reading limit?
Will this stream data, without loading the whole POST request in memory? If not, how to fix it?
It will work if you add any content type that's not "application/x-www-form-urlencoded" to your /write, e.g.:
dd if=/dev/zero bs=1M count=100 | \
curl -H "Content-Type: application/json" --data-binary #- http://localhost:8000/write
This bit in Snap does something like
if contentType == Just "application/x-www-form-urlencoded" then readData maximumPOSTBodySize
where
maximumPOSTBodySize = 10*1024*1024
and x-www-form-urlencoded is curl's default.
To follow up on the previous answer: because forms of type application/x-www-form-urlencoded are so common, as a convenience Snap auto-decodes them for you and puts them into a parameters map in the request. The idea is similar in spirit to e.g. $_POST from PHP.
However, since these maps are read into RAM, naively decoding unbounded amounts of this data would allow an attacker to trivially DoS a server by sending it arbitrary amounts of this input until heap exhaustion. For this reason snap-server limits the amount of data it is willing to read in this way.
I'm having an issue with the Scotty web server right now - rescue isn't working for unfound parameters - I'm still getting a 404 with the following code:
post "/newsletter/create" ( do
(param "subscriber[email]") `rescue` (\msg -> text msg)
formContent <- param "subscriber[email]"
text $ "found! " ++ show formContent )
I can see that when I just use params instead, my data is there, and indexed with "subscriber[email]". Is there something going on with [ escaping? Any help with this would be tremendous.
With some cleanup I got it to work:
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import qualified Data.Text.Lazy as TL
main = scotty 3000 $ do
post "/newsletter/create" $ do
formContent <- (param "subscriber[email]") `rescue` (\msg -> return msg)
text $ "found! " `TL.append` formContent
I made a bunch of modifications, but the key point was that rescue is used as a wrapper around param, not to change any internal state, hence you shouldn't call it twice. The square brackets didn't cause me any trouble.
I'm struggling converting a Response from http-conduit to an XML document via xml-conduit.
The doPost function takes an XML Document and posts it to the server. The server responds with an XML Document.
doPost queryDoc = do
runResourceT $ do
manager <- liftIO $ newManager def
req <- liftIO $ parseUrl hostname
let req2 = req
{ method = H.methodPost
, requestHeaders = [(CI.mk $ fromString "Content-Type", fromString "text/xml" :: Ascii) :: Header]
, redirectCount = 0
, checkStatus = \_ _ -> Nothing
, requestBody = RequestBodyLBS $ (renderLBS def queryDoc)
}
res <- http req2 manager
return $ res
The following works and returns '200':
let pingdoc = Document (Prologue [] Nothing []) (Element "SYSTEM" [] []) []
Response status headers body <- doPost pingdoc
return (H.statusCode status)
However, when I try and parse the Response body using xml-conduit, I run into problems:
Response status headers body <- doPost xmldoc
let xmlRes' = parseLBS def body
The resulting compilation error is:
Couldn't match expected type `L.ByteString'
with actual type `Source m0 ByteString'
In the second argument of `parseLBS', namely `body'
In the expression: parseLBS def body
In an equation for `xmlRes'': xmlRes' = parseLBS def body
I've tried connecting the Source from http-conduit to the xml-conduit using $= and $$, but I'm not having any success.
Does anyone have any hints to point me in the right direction? Thanks in advance.
Neil
You could use httpLbs rather than http, so that it returns a lazy ByteString rather than a Source — the parseLBS function is named because that's what it takes: a Lazy ByteString. However, it's probably best to use the conduit interface that the two are based on directly, as you mentioned. To do this, you should remove the runResourceT line from doPost, and use the following to get an XML document:
xmlRes' <- runResourceT $ do
Response status headers body <- doPost xmldoc
body $$ sinkDoc def
This uses xml-conduit's sinkDoc function, connecting the Source from http-conduit to the Sink from xml-conduit.
Once they're connected, the complete pipeline has to be run using runResourceT, which ensures all allocated resources are released in a timely fashion. The problem with your original code is that it runs the ResourceT too early, from inside doPost; you should generally use runResourceT right at the point that you want an actual result out, because a pipeline has to run entirely within the scope of a single ResourceT.
By the way, res <- http req2 manager; return $ res can be simplified to just http req2 manager.