(fix): parse header field 'Content-Type'

Author: saitmilk

lsp/src/Language/LSP/Server/Control.hs

@@ -20,6 +20,7 @@ import qualified Colog.Core as L
 import           Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&))
 import           Control.Concurrent
 import           Control.Concurrent.STM.TChan
+import           Control.Applicative((<|>))
 import           Control.Monad
 import           Control.Monad.STM
 import           Control.Monad.IO.Class
@@ -186,11 +187,34 @@ ioLoop ioLogger logger clientIn serverDefinition vfs sendMsg = do
               go (parse parser remainder)
 
     parser = do
-      _ <- string "Content-Length: "
-      len <- decimal
-      _ <- string _TWO_CRLF
+      _ <- string "Content-"
+      len <- lengthFirst <|> typeFirst
       Attoparsec.take len
 
+    lengthFirst = do
+      len <- headLength
+      _ <- string _ONE_CRLF
+       <|> (headType >> string _ONE_CRLF)
+      return len
+
+    typeFirst = do
+      _ <- headType
+      _ <- string "Content-"
+      len <- headLength
+      _ <- string _ONE_CRLF
+      return len
+
+    headLength = do
+      _ <- string "Length: "
+      len <- decimal
+      _ <- string _ONE_CRLF
+      return len
+
+    headType = do
+      skipWhile (/='\r')
+      _ <- string _ONE_CRLF
+      return ()
+
 parseOne ::
   MonadIO m
   => LogAction m (WithSeverity LspServerLog)
@@ -236,6 +260,8 @@ sendServer logger msgChan clientOut = do
 -- |
 --
 --
+_ONE_CRLF :: BS.ByteString
+_ONE_CRLF = "\r\n"
 _TWO_CRLF :: BS.ByteString
 _TWO_CRLF = "\r\n\r\n"