I want to download a file/zip archiv. (for example the new ubuntu iso, oe...)
I came across following answer from daydaynatation in this: question
downloadFile :: String -> IO ()
downloadFile url = do
request <- parseRequest url
runResourceT $ httpSink request $ \_ -> sinkFile "tmpfile"
but sadly this downloads only the the site quellcode and not the file which will be downloaded when you navigate to the respective url in the browser of your choice...
So is this possible with this approach or what do I have to try otherwise
Related
I have a simple snaplet, which has its own routing and pretty much independent of the whole application behavior. However, as for most of the application, I want to hide the new simple snaplet under the restricted area, where only logged in users can enter.
For the root snaplet the problem solved by using simple function restricted which accepts a handler and checks if the user logged in, proceeding further with the given handler or redirecting to the login screen.
Here is the whole configuration:
appInit :: SnapletInit App App
appInit = makeSnaplet "myapp" "My Example Application" Nothing $ do
fs <- nestSnaplet "foo" foo fooInit
ss <- nestSnaplet "sess" sess $
initCookieSessionManager "site_key.txt" "sess" (Just 3600)
as <- nestSnaplet "auth" auth $
initJsonFileAuthManager defAuthSettings sess "users.json"
addRoutes [("content", restricted $ render "content"),
("login", login)]
return $ App ss as fs
restricted :: Handler App App () -> Handler App App ()
restricted = requireUser auth (redirect "/login")
fooInit :: SnapletInit b Foo
fooInit = makeSnaplet "foo" "A nested snaplet" Nothing $ do
addRoutes [("info", writeText "Only registered users can have acess to it")]
return Foo
If I enter http://mywebsite/foo/info, I will be able to see the content of the subsnaplet without logging it. It seems to me, that I cannot protect all of the handlers implemented inside of my new Foo without changing that snaplet and modifying its routing. Or am I wrong?
P.S.: There is an option to use weapSite and check the request URL, but since it implies verification based on URL, not on the recourse, (handler in this case) it doesn't seem right to me.
The answer here is to use the wrapSite function. It takes an argument (Handler b v () -> Handler b v ()), which is exactly the type signature of your restricted function.
I'm trying to make the chat example from the Yesod book working in the scaffolding site.
I think I've corrected almost all I had to correct, but all of that is completely new to me (it's my first "real" Haskell project) and I'm not very confident in all my modifications; moreover, I'm really stuck at the point 7. Could you comment all the following points if necessary, and helping me for the 7. (in bold some questions/remarks)?
Copy/paste the Chat.hs and Chat/Data.hs in the root of my site,
add import Chat as Import and import Chat.Data as Import to Import.NoFoundation,
add import of IO, Bool, return, Maybe(Nothing), ($) in Data.hs, since the extension NoImplicitPrelude is on Seems very clumsy... Do we have to import all the standard operators on each new file?
in Fundation.hs, add getChat in the App record (after appHttpManager and appLogger)
in Fundation.hs, add YesodChat instance for App: I had to modify the getUserName on the Just uid case (in the original example of Chat, it was just Just uid -> return uid):
Just uid -> do
muser <- runDB $ get uid
case muser of
Nothing -> error "uid not in the DB"
Just user -> return $ userIdent user
This seems very long and nested... Can we do better?
In Fundation.hs, add chatWidget ChatR after the line pc <- widgetToPageContent $ do in the defaultLayout definition.
Now, I have the following warning :
Application.hs:60:36: Warning:
Fields of ‘App’ not initialised: getChat
In the expression: App {..}
I think I have to write something like getChat <- newChan >>=Chat after the appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger and appStatic <- ... in the makeFundation definition, but the type doesn't match. I'm a totally lost here, I don't really understand how this function makeFundation works.
You actually got almost the entire way there. I think you just need to change the line to:
getChat <- fmap Chat newChan
Alternatively, if you're not familiar with he fmap function yet, you can use do notation and get:
chan <- newChan
let getChat = Chat chan
I need to download files stored on a database.
I believe snap has file utils which help with file upload and download but it only deals with files resident on a filesystem.
I was given advice on the snap IRC to writeBS function to push the data to the browser.
Also, I was told to modify HTTP header so that browser treats the data as a file and brings save/open dialog. I got to play with it today and have more questions.
I have this so far:
getFirst :: AppHandler ()
getFirst = do
modifyResponse $ setContentType "application/octet-stream" -- modify HTTP header
result <- eitherWithDB $ fetch (select [] "files") -- get the file from db
let doc = either (const []) id result -- get the result out of either
fileName = at "name" doc -- get the name of the file
Binary fileData = at "blob" doc -- get the file data
writeBS fileData
Can you please tell me if this is the correct way of doing it?
It works but few things are missing:
How do I pass the file name and file type to the browser?
How do I set the Content-Disposition?
So I need to be able to set something like this:
Content-Disposition: attachment; filename=document.pdf
Content-Type: application/pdf
How can I do this?
You can set an arbitrary header of the response using modifyResponse in combination with setHeader (both from Snap.Core). Like this:
modifyResponse $ setHeader "Content-disposition" "attachment; filename=document.pdf"
I wrote a CRUD application to interface with JIRA. I ended up upgrading my haskell enviornment, because cabal-dev doesn't solve everything. As a result, I've got some breakage, with this error anytime I try to use any code that interfaces with JIRA.
Spike: HandshakeFailed (Error_Misc "user error (unexpected type received. expecting
handshake and got: Alert [(AlertLevel_Warning,UnrecognizedName)])")
After a little googling, I think this either has to do with tls or http-conduit which uses tls.
I'm currently using tls-1.1.2 and http-conduit-1.8.7.1
previously I was using
tls-0.9.11 and http-conduit >= 1.5 && < 1.7 (not sure which exactly, old install is gone.
This is where I believe the break is happening
manSettings :: ManagerSettings
manSettings = def { managerCheckCerts = \ _ _ _-> return CertificateUsageAccept }
this is what it used to look like
manSettings :: ManagerSettings
manSettings = def { managerCheckCerts = \ _ _ -> return CertificateUsageAccept }
Here's the code that uses it
initialRequest :: forall (m :: * -> *). URI -> IO (Request m,Manager)
initialRequest uri = do
initReq <- parseUrl uri -- let the server tell you what the request header
-- should look like
manager <- newManager manSettings -- a Manager manages http connections
-- we mod the settings to handle
-- the SSL cert. See manSettings below.
return (modReq initReq,manager)
where modReq initReq = applyBasicAuth username password initReq
Let me know if I'm left something out. I'm not sure at this point what broke between then and now.
It's a good guess about the error source, but very unlikely: managerCheckCerts simply uses the certificate package to inspect certificates for validity. The error message you're seeing seems to be coming from tls itself and indicates a failure in the data transport. It's probably a good idea to file a bug report with tls, preferably first by narrowing down the issue to a single HTTPS call that fails (or even better, using tls alone and demonstrating the same failure).
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.