Merge branch 'fix-exported-file-extension'

src/Views/Export.hs

@@ -78,7 +78,7 @@ pdfExport ::
     -> Meta
     -> m (Export LB.ByteString)
 pdfExport lang meta =
-    fmap (inline pdf (metaExportFileName Docx meta)) $
+    fmap (inline pdf (metaExportFileName Pdf meta)) $
     withCacheM (bestLanguage lang, mtSlug meta) $ do
         let content = runPandocPure' $ writeHtml $ langContent lang meta
         let title = langTitle lang meta
@@ -91,10 +91,10 @@ pdfExport lang meta =
 wkhtmltopdf :: MonadIO m => LB.ByteString -> m LB.ByteString
 wkhtmltopdf html =
     liftIO $ do
-        (exitCode, pdf, err) <- readCreateProcessWithExitCode wkhtmlProc html
-        let pdf' = filterWkhtmlWarnings pdf
+        (exitCode, output, err) <- readCreateProcessWithExitCode wkhtmlProc html
+        let output' = filterWkhtmlWarnings output
         case exitCode of
-            ExitSuccess -> return pdf'
+            ExitSuccess -> return output'
             ExitFailure _ -> error $ TL.unpack $ decodeUtf8 err
 
 -- wkhtmltopdf, wrapped in xvfb-run as it requires an X display
@@ -125,6 +125,7 @@ filterWkhtmlWarnings output
   where
     startsWithError =
         LB.isPrefixOf "QSslSocket" output ||
+        LB.isPrefixOf "QNet" output ||
         LB.isPrefixOf "libpng warning" output ||
         LB.isPrefixOf "Warning: Ignoring XDG_SESSION_TYPE=wayland" output
     dropThisLine :: LB.ByteString -> LB.ByteString

testsuite/Integration/Base.hs

@@ -6,6 +6,7 @@
 module Integration.Base
     ( TestRequest
     , makeRequest
+    , makeRequestBS
     , makeRequestText
     , simpleRequest
     , assertContains
@@ -14,6 +15,8 @@ module Integration.Base
     , assertTextContains
     , assertTextContainsBefore
     , assertTextNotContains
+    , responseContent
+    , responseHeader
     , testAddress
     , withLang
     , withLang1
@@ -22,11 +25,11 @@ module Integration.Base
 
 import Control.Concurrent.MVar
 
+import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Char
 import Data.List
 import qualified Data.Map as M
-import Data.Monoid
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -52,16 +55,18 @@ testAddress :: T.Text
 testAddress = "http://test"
 
 -- | Make a request to the application
-makeRequest :: TestRequest -> IO LB.ByteString
+makeRequest :: TestRequest -> IO Response
 makeRequest req = do
     happstackReq <- mkRequest req
     app <- loadApp "testsuite/Integration/content" testAddress False
     cache <- initAppCache
-    rsp <- runApp cache app $ simpleHTTP'' site happstackReq
-    responseContent rsp
+    runApp cache app $ simpleHTTP'' site happstackReq
+
+makeRequestBS :: TestRequest -> IO LB.ByteString
+makeRequestBS req = makeRequest req >>= responseContent
 
 makeRequestText :: TestRequest -> IO Text
-makeRequestText = fmap (T.decodeUtf8 . LB.toStrict) . makeRequest
+makeRequestText = fmap (T.decodeUtf8 . LB.toStrict) . makeRequestBS
 
 assertContains :: (Eq a, Show a) => [a] -> [a] -> Assertion
 assertContains needle haystack =
@@ -189,3 +194,6 @@ responseContent f@SendFile {} = do
     let offset = fromIntegral $ sfOffset f
     let count = fromIntegral $ sfCount f
     pure $ LB.drop offset $ LB.take count contents
+
+responseHeader :: String -> Response -> Maybe ByteString
+responseHeader = getHeader

testsuite/Integration/TestFeed.hs

@@ -4,7 +4,6 @@
 module Integration.TestFeed where
 
 import Data.Default.Class
-import Data.Monoid
 
 import Data.XML.Types
 
@@ -23,7 +22,7 @@ atomEntry = "{http://www.w3.org/2005/Atom}entry"
 
 test_home :: IO ()
 test_home = do
-    rss <- makeRequest $ simpleRequest "/feed/en"
+    rss <- makeRequestBS $ simpleRequest "/feed/en"
     xml <-
         case C.parseLBS def rss of
             Left exc -> error $ show exc

testsuite/Integration/TestMeta.hs

@@ -4,7 +4,9 @@
 module Integration.TestMeta where
 
 import qualified Data.ByteString.Lazy as LB
+import Data.Foldable
 import Data.LanguageCodes
+import Data.Text.Encoding (decodeUtf8)
 
 import Integration.Base
 
@@ -23,16 +25,32 @@ test_meta_html = do
 test_meta_pdf :: IO ()
 test_meta_pdf = do
     meta_pdf <- makeRequest $ simpleRequest "/meta.pdf"
-    assertEqual "%PDF" (LB.take 4 meta_pdf)
+    meta_pdf_content <- responseContent meta_pdf
+    assertEqual "%PDF" (LB.take 4 meta_pdf_content)
+    assertEqual
+        (Just "inline; filename=\"meta.pdf\"")
+        (responseHeader "Content-Disposition" meta_pdf)
+
+test_meta_export_custom_slug :: IO ()
+test_meta_export_custom_slug = for_ ["pdf", "docx"] $ \format -> do
+    meta_pdf <- makeRequest $ simpleRequest $ "/custom-slug." <> format
+    assertEqual
+        (Just $ "inline; filename=\"customized-slug." <> format <> "\"")
+        (decodeUtf8 <$> responseHeader "Content-Disposition" meta_pdf)
 
 test_meta_pdf_ru :: IO ()
 test_meta_pdf_ru = do
     meta_pdf <- makeRequest $ withLang1 RU $ simpleRequest "/meta.pdf"
-    assertEqual "%PDF" (LB.take 4 meta_pdf)
+    meta_pdf_content <- responseContent meta_pdf
+    assertEqual "%PDF" (LB.take 4 meta_pdf_content)
 
 test_meta_docx :: IO ()
 test_meta_docx = do
     meta_docx <- makeRequest $ simpleRequest "/meta.docx"
+    meta_docx_content <- responseContent meta_docx
     assertEqual
         "PK" -- DOCX are ZIP files
-        (LB.take 2 meta_docx)
+        (LB.take 2 meta_docx_content)
+    assertEqual
+        (Just "inline; filename=\"meta.docx\"")
+        (responseHeader "Content-Disposition" meta_docx)

testsuite/Integration/TestStatic.hs

@@ -8,9 +8,9 @@ import Integration.Base
 import Test.Framework
 
 test_static = do
-    resp <- makeRequest $ simpleRequest "/some-verification-file.html"
+    resp <- makeRequestBS $ simpleRequest "/some-verification-file.html"
     assertEqual "This is the exact content of the verification file.\n" resp
 
 test_static_index = do
-    resp <- makeRequest $ simpleRequest "/with_index/"
+    resp <- makeRequestBS $ simpleRequest "/with_index/"
     assertEqual "Index file\n" resp

testsuite/Integration/content/meta/custom-slug/en.md

@@ -0,0 +1 @@
+# Custom slug meta!

testsuite/Integration/content/meta/custom-slug/options.yaml

@@ -0,0 +1 @@
+exportSlug: customized-slug