Как мне обработать длительный HTTP-запрос, используя Scotty (Haskell)? - PullRequest
Новая
       29

Как мне обработать длительный HTTP-запрос, используя Scotty (Haskell)?

2 голосов
/ 26 марта 2020

Я делаю простое веб-приложение , которое ищет цветные слова в тексте и строит статистику о них. Вы можете проверить его на colors.jonreeve.com , если он не слишком занят. Я использую веб-фреймворк Scotty для работы с Интернетом. Он работает хорошо для коротких текстов, но более длинные тексты, такие как полные романы, занимают так много времени, что браузер обычно отключается. Итак, я думаю, что мне нужно здесь, это отправить форму через Jquery AJAX или что-то еще, а затем заставить сервер отправлять JSON так часто со своим статусом («сейчас загружается файл»), теперь подсчитываются цвета , "et c) и затем, когда он получает сигнал" успех ", затем перенаправить на какой-то другой URL?

Я впервые пытаюсь сделать что-то подобное, так что прости меня, если все это звучит неосведомленно. Я также заметил, что есть некоторые похожие вопросы, но у меня есть ощущение, что Скотти работает немного иначе, чем большинство установок. Я заметил, что есть несколько функций для настройки необработанного вывода, установки заголовков и так далее. Я пытаюсь излучать определенные сигналы на каждом этапе анализа? И как бы я это сделал, учитывая Haskell обработку побочных эффектов? Я изо всех сил пытаюсь даже думать о лучшем подходе, здесь.

Ответы [ 2 ]

1 голос
/ 27 марта 2020

Вместо одного длительного GET-запроса, я бы, возможно, настроил конечную точку, принимающую POST-запросы. POST будет немедленно возвращен с двумя ссылками в теле ответа:

  • одна ссылка на новый ресурс, представляющий результат задачи, который не будет немедленно доступен. До этого GET-запросы к результату могли возвращать 409 (Конфликт) .

  • одну ссылку на связанный, немедленно доступный ресурс, представляющий уведомления, испускаемые при выполнении задачи.

Как только клиент успешно выполнит GET ресурса результата задачи, он может УДАЛИТЬ его. Это должно удалить как ресурс результата задачи, так и связанный ресурс уведомления.

Для каждого запроса POST вам потребуется порождать фоновый рабочий поток . Вам также потребуется фоновый поток для удаления устаревших результатов задачи (поскольку клиенты могут быть ленивыми и не вызывать DELETE). Эти потоки будут взаимодействовать с MVar s , TVar s , каналами или аналогичными методами .

Теперь вопрос: как лучше всего обрабатывать уведомления, отправляемые сервером? Есть несколько опций :

  • Просто периодически опрашивайте ресурс уведомления от клиента. Недостатки: потенциально много HTTP-запросов, уведомления не принимаются быстро.
  • длинный опрос . последовательность запросов GET, которые остаются открытыми до тех пор, пока сервер не захочет отправить какое-либо уведомление, или до истечения времени ожидания.
  • события, отправленные сервером . wai-extra имеет поддержку для этого, но я не знаю, как подключить raw wai Application обратно к Скотти.
  • WebSockets . Не уверен, как интегрироваться со Скотти.

Вот серверный скелет длинного механизма опроса. Некоторые предварительные импорта: 

{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) -- from async
import Control.Concurrent.STM -- from stm
import Control.Concurrent.STM.TMChan -- from stm-chans
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON) -- from aeson
import Data.Foldable (for_)
import Data.Text (Text) 
import Web.Scotty

А вот и основной код. 

main :: IO ()
main =
  do
    chan <- atomically $ newTMChan @Text
    concurrently_
      ( do
          for_
            ["starting", "working on it", "finishing"]
            ( \msg -> do
                threadDelay 10e6
                atomically $ writeTMChan chan msg
            )
          atomically $ closeTMChan chan
      )
      ( scotty 3000
          $ get "/notifications"
          $ do
            mmsg <- liftIO $ atomically $ readTMChan chan
            json $
              case mmsg of
                Nothing -> ["closed!"]
                Just msg -> [msg]
      )

Существует два одновременных потока. Один передает сообщения в закрываемый канал с 10-секундными интервалами , другой запускает сервер Scotty, где каждый вызов GET зависает, пока новое сообщение не поступит в канал.

Тестируя его с bash, используя curl , мы должны увидеть последовательность сообщений: 

bash$ for run in {1..4}; do curl -s localhost:3000/notifications ; done
["starting"]["working on it"]["finishing"]["closed!"]
0 голосов
/ 30 марта 2020

Для сравнения приведу скелет решения, основанного на отправленных сервером событиях . Он использует yesod вместо scotty , хотя Yesod предлагает способ перехватить в качестве обработчика wai-extra Application, который управляет событиями.

Код Haskell 

{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) -- from async
import Control.Concurrent.STM -- from stm
import Control.Concurrent.STM.TMChan -- from stm-chans
import Control.Monad.IO.Class (liftIO)
import Data.Binary.Builder -- from binary
import Data.Foldable (for_)
import Network.Wai.EventSource -- from wai-extra
import Network.Wai.Middleware.AddHeaders -- from wai-extra
import Yesod -- from yesod

data HelloWorld = HelloWorld (TMChan ServerEvent)

mkYesod
  "HelloWorld"
  [parseRoutes|
/foo FooR GET
|]

instance Yesod HelloWorld

getFooR :: Handler ()
getFooR = do
  HelloWorld chan <- getYesod
  sendWaiApplication
    . addHeaders [("Access-Control-Allow-Origin", "*")]
    . eventStreamAppRaw
    $ \send flush ->
      let go = do
            mevent <- liftIO $ atomically $ readTMChan chan
            case mevent of
              Nothing -> do
                send CloseEvent
                flush
              Just event -> do
                send event
                flush
                go
       in go

main :: IO ()
main =
  do
    chan <- atomically $ newTMChan
    concurrently_
      ( do
          for_
            [ ServerEvent
                (Just (fromByteString "ev"))
                (Just (fromByteString "id1"))
                [fromByteString "payload1"],
              ServerEvent
                (Just (fromByteString "ev"))
                (Just (fromByteString "id2"))
                [fromByteString "payload2"],
              ServerEvent
                (Just (fromByteString "ev"))
                (Just (fromByteString "eof"))
                [fromByteString "payload3"]
            ]
            ( \msg -> do
                threadDelay 10e6
                atomically $ writeTMChan chan msg
            )
          atomically $ closeTMChan chan
      )
      ( warp 3000 (HelloWorld chan)
      )

И небольшая пустая страница для проверки отправленных сервером событий. Сообщения появляются в браузере console : 

<!DOCTYPE html>
<html lang="en">
<body>
</body>
<script>
    window.onload = function() {
        var source = new EventSource('http://localhost:3000/foo'); 
        source.onopen = function () { console.log('opened'); }; 
        source.onerror = function (e) { console.error(e); }; 
        source.addEventListener('ev', (e) => {
            console.log(e);
            if (e.lastEventId === 'eof') {
                source.close();
            }
        });
    }
</script>
</html>
...