From 87daaa37a970095dfd4a5ded89bc436ff4460663 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Mon, 15 Aug 2022 09:20:15 -0700
Subject: [PATCH] Server: allow setting Accept:'application/octet-stream'...

to receive raw bytes instead of base64 encoded binary output,
e.g. docx.
---
 server/PandocServer.hs | 31 ++++++++++++++++++++-----------
 1 file changed, 20 insertions(+), 11 deletions(-)

diff --git a/server/PandocServer.hs b/server/PandocServer.hs
index 990be7df3..c53a97645 100644
--- a/server/PandocServer.hs
+++ b/server/PandocServer.hs
@@ -23,25 +23,26 @@ import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
 import Data.Maybe (fromMaybe)
 import Data.Char (isAlphaNum)
-import Data.ByteString.Lazy (fromStrict, toStrict, ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BL
 import Data.ByteString.Base64 (decodeBase64, encodeBase64)
 import Data.Default
 import Data.Set (Set)
 import Skylighting (defaultSyntaxMap)
 
-newtype Blob = Blob ByteString
+newtype Blob = Blob BL.ByteString
   deriving (Show, Eq)
 
 instance ToJSON Blob where
-  toJSON (Blob bs) = toJSON (encodeBase64 $ toStrict bs)
+  toJSON (Blob bs) = toJSON (encodeBase64 $ BL.toStrict bs)
 
 instance FromJSON Blob where
  parseJSON = withText "Blob" $ \t -> do
    let inp = UTF8.fromText t
    case decodeBase64 inp of
-        Right bs -> return $ Blob $ fromStrict bs
+        Right bs -> return $ Blob $ BL.fromStrict bs
         Left _ -> -- treat as regular text
-                    return $ Blob $ fromStrict inp
+                    return $ Blob $ BL.fromStrict inp
 
 -- This is the data to be supplied by the JSON payload
 -- of requests.  Maybe values may be omitted and will be
@@ -158,6 +159,8 @@ $(deriveJSON defaultOptions ''Params)
 type API =
   ReqBody '[JSON] Params :> Post '[PlainText, JSON] Text
   :<|>
+  ReqBody '[JSON] Params :> Post '[OctetStream] BS.ByteString
+  :<|>
   "batch" :> ReqBody '[JSON] [Params] :> Post '[JSON] [Text]
   :<|>
   "babelmark" :> QueryParam' '[Required] "text" Text :> QueryParam "from" Text :> QueryParam "to" Text :> QueryFlag "standalone" :> Get '[JSON] Value
@@ -172,6 +175,7 @@ api = Proxy
 
 server :: Server API
 server = convert
+    :<|> convertBytes
     :<|> mapM convert
     :<|> babelmark  -- for babelmark which expects {"html": "", "version": ""}
     :<|> pure pandocVersion
@@ -188,10 +192,15 @@ server = convert
   -- Changing this to
   --    handleErr =<< liftIO (runIO (convert' params))
   -- will allow the IO operations.
-  convert params = handleErr $ runPure (convert' params)
+  convert params = handleErr $
+    runPure (convert' id (encodeBase64 . BL.toStrict) params)
 
-  convert' :: PandocMonad m => Params -> m Text
-  convert' params = do
+  convertBytes params = handleErr $
+    runPure (convert' UTF8.fromText BL.toStrict params)
+
+  convert' :: PandocMonad m
+           => (Text -> a) -> (BL.ByteString -> a) -> Params -> m a
+  convert' textHandler bsHandler params = do
     let readerFormat = fromMaybe "markdown" $ from params
     let writerFormat = fromMaybe "html" $ to params
     (readerSpec, readerExts) <- getReader readerFormat
@@ -270,10 +279,10 @@ server = convert
                   let eitherbs = decodeBase64 $ UTF8.fromText t
                   case eitherbs of
                     Left errt -> throwError $ PandocSomeError errt
-                    Right bs -> r readeropts $ fromStrict bs
+                    Right bs -> r readeropts $ BL.fromStrict bs
     let writer = case writerSpec of
-                TextWriter w -> w writeropts
-                ByteStringWriter w -> fmap (encodeBase64 . toStrict) . w writeropts
+                TextWriter w -> fmap textHandler . w writeropts
+                ByteStringWriter w -> fmap bsHandler . w writeropts
     reader (text params) >>=
       (if citeproc params == Just True
           then processCitations