流字節到網絡websocket

Question

我有一個代碼使用文件句柄來模擬源（ AWS S3 ） Bytestring式Bytestring器。 如果我們想用Network.Websocket作為水槽，就足夠了交換LBS.writeFile在下面的代碼sendBinaryData （帶手柄連接）？

{-# LANGUAGE OverloadedStrings,ScopedTypeVariables #-}

import qualified Aws
import qualified Aws.S3 as S3
import           Data.Conduit (($$+-))
import qualified Data.Conduit.List as CL (mapM_)
import qualified Data.ByteString.Streaming.HTTP as SP
import qualified Data.ByteString.Lazy as LBS
import Streaming as S
import Streaming.Prelude as S hiding (show,print)
import Control.Concurrent.Async (async,waitCatch)
import Data.Text as T (Text)

data AwsConfig a = AwsConfig { _aws_cfg :: Aws.Configuration, _aws_s3cfg :: S3.S3Configuration a, _aws_httpmgr :: SP.Manager }

getObject :: AwsConfig Aws.NormalQuery -> T.Text -> T.Text ->  IO Int
getObject cfg bucket key = do
  req <- waitCatch =<< async (runResourceT $ do
    {- Create a request object with S3.getObject and run the request with pureAws. -}
    S3.GetObjectResponse { S3.gorResponse = rsp, S3.gorMetadata = mdata } <- 
      Aws.pureAws (_aws_cfg cfg) (_aws_s3cfg cfg) (_aws_httpmgr cfg) $
        S3.getObject bucket key
    {- Stream the response to a lazy bytestring -}
    liftIO $ LBS.writeFile "testaws" LBS.empty -- this will be replaced by content-length of the bytes 
    let obj = (($$+- CL.mapM_ S.yield) . hoist lift ) (SP.responseBody rsp)
    S.mapM_ (liftIO . (LBS.appendFile "testaws") . LBS.fromStrict) obj
    return $ lookup "content-length" (S3.omUserMetadata mdata))
  case req of
    Left _ -> return 2 -- perhaps, we could use this to send an error message over websocket
    Right _ -> return 0

對我來說，困惑的根源是如何確定流的終止？ 對於文件，可通過writeFile API來解決。 那么sendBinaryData呢？ 它是否以與writeFile類似的方式處理終止？ 還是由客戶端的數據解析器確定？

更新資料

這個問題是關於如何像上例中的文件句柄一樣將數據流式傳輸到websocket句柄（讓我們假定已提供了句柄），而不是真正地關於如何在resourceT管理句柄。 conduit似乎確實采用mapM_方法接收數據。 因此，似乎確實是要走的路。

終止問題是因為我的這種思路：如果我們有一個函數在Websocket句柄的另一側監聽數據，那么確定消息的結尾似乎在流上下文中很重要。 給定如下功能：

f :: LBS.ByteString -> a

如果我們執行S.mapM_將數據流傳輸到websocket句柄，是否需要添加某種end of stream標記end of stream以便另一側的f偵聽可以停止處理惰性字節串。 否則， f將不知道消息何時完成。

Answer 1

您認為句柄將需要其他技巧是正確的。 但是，由於您已經在使用ResourceT monad轉換器，因此使用allocate非常簡單 。 allocate允許您在資源monad中創建一個句柄並注冊清除操作（在您的情況下，這只是關閉連接）。

ok <- runResourceT $ do
  (releaseKey, handle) <-
    allocate (WebSockets.acceptRequest request) 
             (`WebSockets.sendClose` closeMessage)
  WebSockets.sendBinaryData handle data
  return ok
where
  request = ...
  closeMessage = ...
  data = ...
  ok = ...

通過使用allocate ，可以確保在runResourceT返回ok時關閉句柄。

但是，我不能完全確定這就是您想要的。 在我看來， getObject不應該知道如何接受和關閉WS連接； 也許應該將WS連接句柄作為參數，然后寫入。 如果將其返回類型升級為ResourceT則可以向調用方收取getObject費用，該調用方負責調用runResourceT和分配WS句柄等。 但希望上面的示例足以使您繼續前進。

Answer 2

（注意-代碼未經測試。）

您的代碼將重新打開輸出文件，並在每次輸入數據包時都將其追加。顯然，更好的解決方案是使用LBS.hPutStr使用已打開的文件句柄寫入文件。

也就是說，代替：

S.mapM_ (liftIO . (LBS.appendFile "testaws") . LBS.fromStrict) obj

您要使用：

S.mapM_ (liftIO . (LBS.hPutStr h) . LBS.fromStrict) obj

當然，這引用了句柄h ，它是從哪里來的？

一種解決方案是在調用getObject的主體之前將其傳遞到getObject或以其他方式創建它，例如：

getObject cfg bucket key = withFile "output" $ \h -> do
    req <- ...
    ...
    S.mapM_ (liftIO . (LBS.hPutStr h) . LBS.fromStrict) obj
    ...

或者，也許您必須在runResourceT內部創建...我不確定。

更新 -有關如何讓ResourceT為您管理文件句柄的信息，請參見@haoformayor的答案。

Answer 3

這里有些零碎的內容可能會使事情更容易理解。 首先，對於第一個小演示，修改您的getObject ，無論如何，我都使用ResourceT Streaming.ByteString.writeFile ，通過延遲字節串來繞開彎路。

{-# LANGUAGE OverloadedStrings,ScopedTypeVariables #-}

import qualified Aws
import qualified Aws.S3 as S3
import           Data.Conduit 
import qualified Data.Conduit.List as CL (mapM_)
import qualified Data.ByteString.Streaming.HTTP as HTTP
import qualified Data.ByteString.Streaming as SB
import qualified Data.ByteString.Streaming.Internal as SB
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import           Streaming as S
import           Streaming.Prelude as S hiding (show,print)
import           Control.Concurrent.Async (async,waitCatch)
import           Data.Text as T (Text) 
import qualified Network.WebSockets as WebSockets
import           Control.Monad.Trans.Resource

data AwsConfig a = AwsConfig { _aws_cfg :: Aws.Configuration
                             , _aws_s3cfg :: S3.S3Configuration a
                             , _aws_httpmgr :: HTTP.Manager }

getObject :: AwsConfig Aws.NormalQuery -> FilePath -> T.Text -> T.Text ->  IO Int
getObject cfg file bucket key = do
  req <- waitCatch =<< async (runResourceT $ do
    S3.GetObjectResponse { S3.gorResponse = rsp, S3.gorMetadata = mdata } <- 
      Aws.pureAws (_aws_cfg cfg) (_aws_s3cfg cfg) (_aws_httpmgr cfg) $
        S3.getObject bucket key
    let bytestream = do 
         -- lookup "content-length" (S3.omUserMetadata mdata))
         SB.chunk B.empty -- this will be replaced by content-length 
         hoist lift (HTTP.responseBody rsp)  $$+- CL.mapM_ SB.chunk 
    SB.writeFile file bytestream ) -- this is in ResourceT 
  case req of
    Left _ -> return 2
    Right _ -> return 0

我們可以從中大致抽象出您使用SB.writeFile所做的SB.writeFile ：

getObjectAbstracted
      :: (SB.ByteString (ResourceT IO) () -> ResourceT IO b)
         -> AwsConfig Aws.NormalQuery -> S3.Bucket -> Text -> ResourceT IO b
getObjectAbstracted action cfg bucket key = do
    S3.GetObjectResponse { S3.gorResponse = rsp, S3.gorMetadata = mdata } <- 
      Aws.pureAws (_aws_cfg cfg) 
                  (_aws_s3cfg cfg) 
                  (_aws_httpmgr cfg) 
                  (S3.getObject bucket key)

    action (hoist lift (HTTP.responseBody rsp)  $$+- CL.mapM_ SB.chunk) 

現在，我們需要一個不包含在流字節字符串庫中的小助手

mapMChunks_ :: Monad m => (B.ByteString -> m ()) -> SB.ByteString m r -> m r
mapMChunks_ act bytestream = do
  (a S.:> r) <- SB.foldlChunksM (\_ bs -> act bs) (return ()) bytestream
  return r

並可以使用流字節串按@haoformayor的計划進行或多或少的處理

writeConnection :: MonadIO m => WebSockets.Connection -> SB.ByteString m r -> m r
writeConnection connection  = 
  mapMChunks_ (liftIO . WebSockets.sendBinaryData connection)

-- following `haoformayor`
connectWrite
    :: (MonadResource m, WebSockets.WebSocketsData a) 
    => WebSockets.PendingConnection 
    -> a                  -- closing  message
    -> SB.ByteString m r  -- stream from aws
    -> m r
connectWrite request closeMessage bytestream = do
    (releaseKey, connection) <- allocate (WebSockets.acceptRequest request)
                                         (`WebSockets.sendClose` closeMessage)
    writeConnection connection bytestream

getObjectWS :: WebSockets.WebSocketsData a =>
       WebSockets.PendingConnection
       -> a
       -> AwsConfig Aws.NormalQuery
       -> S3.Bucket
       -> Text
       -> ResourceT IO ()
getObjectWS request closeMessage = getObjectAbstracted (connectWrite request closeMessage)

當然，到目前為止，這些都沒有利用conduit和streaming / streaming-bytestring之間的差異。