I'm trying to POST a multipart form request to an internal website which should reply with an XML response. Using another simple script I have in Python with the requests library, everything works fine, however, using http-conduit I keep receiving an exception ExpectedBlankAfter100Continue.
If I replace the internal url with "https://httpbin.org/post", I also receive a reply back without issue.
Is there something I'm doing wrong? It seems like either a bug in the library or the site is not behaving as expected. If the latter is the case, is there an option for me to disable this check in http-conduit?
Sample code:
{-# LANGUAGE OverloadedStrings #-}
import Network
import Network.HTTP.Conduit
import Network.HTTP.Client.MultipartFormData
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Maybe (fromJust)
import System.Environment (getArgs)
import Control.Monad.IO.Class
main = do
[x] <- getArgs
--let url = "https://url.net/api.asp"
let url = "https://httpbin.org/post"
withSocketsDo $ withManager $ \m -> do
r <- flip httpLbs m =<< (formDataBody (request $ BL.pack x) $ fromJust $ parseUrl url)
liftIO $ BL.putStrLn $ responseBody r
request :: BL.ByteString -> [Part]
request x = <code removed>
This sounds like the server is returning a malformed 100-continue response. But there's not enough information here to properly debug this, it's probably better to handle this in a Github issue.
Related
I tried building a simple client-server program following this tutorial about Haskell's network-conduit library.
This is the client, which concurrently sends a file to the server and receives the answer:
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (concurrently)
import Data.Functor (void)
import Conduit
import Data.Conduit.Network
main = runTCPClient (clientSettings 4000 "localhost") $ \server ->
void $ concurrently
(runConduitRes $ sourceFile "input.txt" .| appSink server)
(runConduit $ appSource server .| stdoutC)
And this is the server, which counts the occurrences of each word and sends the result back to the client:
{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Char8 (pack)
import Data.Foldable (toList)
import Data.HashMap.Lazy (empty, insertWith)
import Data.Word8 (isAlphaNum)
import Conduit
import Data.Conduit.Network
import qualified Data.Conduit.Combinators as CC
main = runTCPServer (serverSettings 4000 "*") $ \appData -> do
hashMap <- runConduit $ appSource appData
.| CC.splitOnUnboundedE (not . isAlphaNum)
.| foldMC insertInHashMap empty
runConduit $ yield (pack $ show $ toList hashMap)
.| iterMC print
.| appSink appData
insertInHashMap x v = do
return (insertWith (+) v 1 x)
The problem is that the server doesn't reach the yield phase until I manually shut down the client and therefore never answers to it. I noticed that removing the concurrency from the client and keeping only the part in which it sends data to the server, everything works fine.
So, how can I preserve the receiving part of the client without breaking the flow?
You have a deadlock: the client is waiting for the server to respond before it closes the connection, but the server is unaware that the client is done sending data and is waiting for more. This is basically the problem described at https://cr.yp.to/tcpip/twofd.html:
When the generate-data program finishes, the same fd is still open in the consume-data program, so the kernel has no idea that it should send a FIN.
In your case, the fix needs to go on the client side. You need to call shutdown with ShutdownSend on the socket once conduit is done sending the contents of input.txt over it.
Here's one way to do so (I'm not sure if there's a nicer one):
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (concurrently)
import Data.Functor (void)
import Data.Foldable (traverse_)
import Conduit
import Data.Conduit.Network
import Data.Streaming.Network (appRawSocket)
import Network.Socket (shutdown, ShutdownCmd(..))
main = runTCPClient (clientSettings 4000 "localhost") $ \server ->
void $ concurrently
((runConduitRes $ sourceFile "input.txt" .| appSink server) >> doneWriting server)
(runConduit $ appSource server .| stdoutC)
doneWriting = traverse_ (`shutdown` ShutdownSend) . appRawSocket
Side note: you don't really need concurrency in the client in this case, since there will never be anything to read from the server until you're done writing to the server. You could just do the reading after the writing and shutdown.
I'm trying out Scotty for the first time and I can't seem to get past making my GET request. The Response is returned as type
IO (Response bytestring-0.10.8.1:Data.ByteString.Lazy.Internal.ByteString)
I know I need to convert it to a type that can be output by Scotty but I can't figure out how to do that.
My full code is :
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Lens
import Control.Monad.IO.Class
import Data.Aeson (FromJSON, ToJSON, Value, decode,
encode)
import Data.Map as Map
import GHC.Generics
import Lib
import Network.Wreq as Wreq
import Web.Scotty as Scotty
main :: IO ()
main =
scotty 3000 $
Scotty.get "/" $ do
-- html "Hello World!"
Wreq.get"https://www.metaweather.com/api/location/search/?query=New%20York"
I tried using LiftIO but that is still giving me a Type Error. I wanted to know how exactly I should convert my Response so that I can display it in the front-end just like I displayed my initial "Hello World" with html.
If you are just looking for a quick proof of concept and aren't worried about erroneous responses, you could use the responseBody lens and send the lazy byte string to raw instead of html:
main :: IO ()
main =
scotty 3000 $
Scotty.get "/" $ do
r <- liftIO $ Wreq.get "https://www.metaweather.com/api/location/search/?query=New%20York"
raw (r ^. responseBody)
I want to download the content of the URL
http://example.com/foobar?key1=value1&key2=value2
using http-conduit (GET request).
How can I do that:
a) Assuming I already know the full (i.e. encoded URL)
b) If some parameters are dynamic and therefore not URL-encoded?
Note: This question was answered Q&A-style and therefore intentionally does not show any research effort.
Regarding a):
You can use simpleHttp with an URL containing query parameters just like the example in the docs:
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit
import qualified Data.ByteString.Lazy as LB
main :: IO ()
main =
simpleHttp "http://example.com/foobar?key1=value1&key2=value2" >>= LB.putStr
Regarding b):
You need a list of key/value tuples of type [(ByteString, Maybe ByteString)] that contains your query parameters.
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LB
queryParams :: [(ByteString, Maybe ByteString)]
queryParams = [
("key1", Just "value1"),
("key2", Just "value2")]
main :: IO ()
main = do
request <- parseUrl "http://example.com/foobar"
let request' = setQueryString queryParams request
response <- withManager $ httpLbs request'
LB.putStrLn $ responseBody response
Note: This requires at least http-conduit 2.1.
Also note that it is recommended to reuse Manager instances where applicable.
This is more than likely me missing some vital piece of information or something, but here goes.
Currently I'm trying to insert my own header, namely x-oauth-basic, into my HTTP request using the HTTP.Conduit library. It sorta works, but not in my intended way,
submitPostRequest urlString githubKey body =
case parseUrl urlString of
Nothing -> return $ "URL Syntax Error"
Just initReq -> withManager $ \manager -> do
let req = initReq { secure = False -- Turn on https
, method = "POST"
, requestHeaders = [("x-oauth-basic", (encodeUtf8 githubKey))]
<> [("User-Agent", "HsCMS")]
, requestBody = RequestBodyBS (toStrict body)
, checkStatus = \_ _ _ -> Nothing
}
res <- httpLbs req manager
return $ responseBody res
the important bit being
requestHeaders = [("x-oauth-basic", (encodeUtf8 githubKey))]
<> [("User-Agent", "HsCMS")]
Using a HTTP sinkhole, I can see the header is formed as HTTP_X_OAUTH_BASIC. It shouldn't have the HTTP bit in front. Testing with curl,
curl -u 78y8713k1j23nkjnkjnuy366366363666gdasddd:x-oauth-basic --request POST --data '{"description":"Updated via API","files":{"file1.txt":{"filename": "newsies.txt", "content":"New Demo"}}' http://www.posttestserver.com/post.php\?dir\=Testing
the header doesn't appear there, which suggests that the sinkhole doesn't pick up x-headers. The curl example also works with my intended endpoint which is the github API, so I know the curl approach is correct, and my HTTP.Conduit one is not.
So my question is, how do I get my HTTP.Conduit header to appear as a x-header, such as curls', instead of the current http-x-header that I'm getting?
Also, don't worry, the github key used is not an actual key...
Update and fix
So, as mentioned in a comment to Michael Snoymans' answer, it got solved by using a different header, namely ("Authorization", "token " <> (encodeUtf8 githubKey)) which apparently was somewhat what CURL was sending when doing <token>:x-oauth-basic.
I've tried to update the title to fit a little better, but am open to suggestions...
Thanks for all the help!
I think the problem is with your sinkhole application. It appears like it's printing CGI versions of the headers. I don't know what the sinkhole looks like, so I implemented a simple one in Warp, and indeed the request header is being passed through correctly. You can clone the project on FP Haskell Center to try it out yourself. For completeness, here's the code below:
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (withAsync)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.Monoid (mempty, (<>))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Network.HTTP.Conduit (RequestBody (RequestBodyBS),
checkStatus, httpLbs, method,
parseUrl, requestBody,
requestHeaders, responseBody, secure,
withManager)
import Network.HTTP.Types (status200)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (run)
import System.Environment (getEnv)
main :: IO ()
main = do
port <- fmap read $ getEnv "PORT"
withAsync (run port app) $ const $ do
submitPostRequest
("http://localhost:" ++ show port)
"dummy-key"
"dummy body" >>= print
app :: Wai.Application
app req = do
liftIO $ mapM_ print $ Wai.requestHeaders req
return $ Wai.responseLBS status200 [] mempty
submitPostRequest :: String -> Text -> ByteString -> IO L.ByteString
submitPostRequest urlString githubKey body =
case parseUrl urlString of
Nothing -> return $ "URL Syntax Error"
Just initReq -> withManager $ \manager -> do
let req = initReq { secure = False -- Turn on https
, method = "POST"
, requestHeaders = [("x-oauth-basic", (encodeUtf8 githubKey))]
<> [("User-Agent", "HsCMS")]
, requestBody = RequestBodyBS body
, checkStatus = \_ _ _ -> Nothing
}
res <- httpLbs req manager
return $ responseBody res
When I run this, the output in the console is:
("Host","localhost:8004")
("Accept-Encoding","gzip")
("Content-Length","10")
("x-oauth-basic","dummy-key")
("User-Agent","HsCMS")
Empty
I'm trying to use the package RSS with UTF8 string with no avail. (i don't want to use HXT which works, i just want to understand where i'm wrong)
In ghci when i put "test" i just get garbage with character such as "é".
If i get the string from reading a file with UTF8.readFile and send it to parseFromString it works, but when i download and use getRespBody it doesn't.
Here is my sample code :
import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
import Data.Maybe (fromJust)
import Text.Feed.Import (parseFeedString)
import Text.RSS.Syntax
import Text.Feed.Types (Feed(..))
import Prelude hiding (putStrLn)
import Data.ByteString.Char8 (putStrLn)
import Data.ByteString.UTF8 (fromString)
siteUrl = "http://radiofrance-podcast.net/podcast09/rss_11549.xml"
type Links = [(String,String,String)]
-------------------------------------------------------------------------------
-- Main function
-------------------------------------------------------------------------------
test = getLinks siteUrl >>= mapM_ (putStrLn.fromString)
-------------------------------------------------------------------------------
-- Retrieve titles
-------------------------------------------------------------------------------
getLinks:: String -> IO [String]
getLinks url = simpleHTTP (getRequest url) >>= getResponseBody >>= parseDoc
parseDoc d = do
let RSSFeed rss = (fromJust . parseFeedString ) d
items = rssItems.rssChannel $ rss
titles = map (fromJust.rssItemTitle) items
return $ titles
Update:
thanks to Roman's answer, i have modified my code. Here are the modification for anyone who may be interested.
import Codec.Binary.UTF8.String (decodeString) -- <-- added
getLinks:: String -> IO [String]
getLinks url = simpleHTTP (getRequest url) >>= getResponseBody >>= parseDoc.decodeString -- <-- modified
The fact that simpleHTTP may return String-based responses is a bit confusing. In reality they are not Unicode strings, but byte strings that contain the HTTP response as is. No automatic decoding is done.
So, you need to decode the http response before passing it to feed parsing functions (e.g. using the encoding or utf8-string package).
You probably want to extract the source encoding information from the Content-Type http header or from the RSS document itself.