I mentioned the other day I was playing with yesod-websocket, and my method was taking some existing Handler functions and adding websocket "commands" that map to those requests, and updating the Angular app talking to Haskell backend to use websockets for those specific requests.
I was surprised to see >100% increase in request time for a GET request vs a websocket message.
It's not a perfect comparison since I am passing slightly different json and parsing it differently.
That being said, here is my attempt to succintly describe what is going on:
I have a function
processImage :: SessionId -> String -> Value -> Int -> Handler String
Both my GET /session/#SessionId and equivalent websocket.send() Handlers use this main function
The JSON for the websocket looks
{process_image: {session_id : "theid", <process_image_fields>}
while the JSON for the GET request (since the session_id and command are in the URL/Verb) is simply
{<process_image_fields>}
The requests were much slower when being called against the websocket, so I set out to profile to find out why.
When using fprof-auto and NOT using websocket, the profile looks something like:
MAIN MAIN 59.7 79.8
unstream/resize Data.Text.Fusion 19.6 14.0
jstring_ Data.Aeson.Parser.Internal 7.5 2.1
break Data.Aeson.Encode 5.8 0.0
main Main 3.0 2.4
encode Data.Aeson.Encode 1.9 0.5
However, when I am using websockets (and also adding some custom SSC's to try and figure out what is going on)
parseFromStreamInternal.go.\ System.IO.Streams.Internal.Attoparsec 34.1 48.0
MAIN MAIN 24.1 15.4
unstream/resize Data.Text.Fusion 16.1 9.3
parse_vmxcommand Handler.WebSocket 8.8 22.1
jstring_ Data.Aeson.Parser.Internal 6.0 1.1
main Main 3.1 2.5
break Data.Aeson.Encode 2.7 0.0
encode Data.Aeson.Encode 2.6 0.3
You'll notice that parseFromStreamInternal is absolutely dominating here.
The relevant part of the profile is which is a direct child of MAIN.
parseFromStreamInternal System.IO.Streams.Internal.Attoparsec 1610 1 0.2 0.0 35.2 48.4
parseFromStreamInternal.go System.IO.Streams.Internal.Attoparsec 1757 0 0.0 0.0 0.0 0.0
_read System.IO.Streams.Internal 1758 34 0.0 0.0 0.0 0.0
parseFromStreamInternal.\ System.IO.Streams.Internal.Attoparsec 1738 35 0.0 0.0 35.0 48.4
parseFromStreamInternal.go System.IO.Streams.Internal.Attoparsec 1739 603 0.9 0.4 35.0 48.4
parseFromStreamInternal.go.\ System.IO.Streams.Internal.Attoparsec 1759 568 34.1 48.0 34.1 48.0
parseFromStreamInternal.leftover System.IO.Streams.Internal.Attoparsec 1740 35 0.0 0.0 0.0 0.0
_read System.IO.Streams.Internal 1611 35 0.0 0.0 0.0 0.0
_read
Relevant code:
-- routes:
/session/#SessionId ProcessImageR POST OPTIONS
/websocket WebSocketR GET
data ProcessImageCommand = ProcessImageCommand {
picImage :: String,
processImageParams :: Value,
picTime :: Int
}
instance FromJSON ProcessImageCommand where
parseJSON (Object o) = do
ProcessImageCommand <$> (o .: "image") <*> (o .: "params") <*> (o .: "time")
parseJSON _ = mzero
postProcessImageR :: SessionId -> Handler String
postProcessImageR sid = do
addHeader "Access-Control-Allow-Origin" "*"
addHeader "Content-Type" "application/json"
(pic :: ProcessImageCommand) <- requireJsonBody
processImage sid (picImage pic) (processImageParams pic) (picTime pic) >>= return
data VMXCommand = CreateSession (Maybe String)
| GetSessions
| ProcessImage SessionId String Value Int
instance FromJSON VMXCommand where
parseJSON j = do
o <- {-# SCC "parse_vmxcommand" #-} parseJSON j
case H.toList (o :: Object) of
[("new_connection", Object o')] -> CreateSession <$> o' .: "model_name"
[("process_image", Object o')] -> ProcessImage <$> (o' .: "session_id") <*> (o' .: "image") <*> (o' .: "params") <*> (o' .: "time")
[("list_sessions", Object o')] -> return GetSessions
_ -> fail "Rule: unexpected format"
vmxWebSocket :: WebSocketsT Handler ()
vmxWebSocket = (forever $ do
(d :: L.ByteString) <- {-# SCC "receiveData" #-} receiveData
let (wsc :: Either String VMXCommand) = {-# SCC "decode_websocket" #-} eitherDecode d
case wsc of
Left error' -> sendTextData $ pack error'
Right command' ->
case command' of
CreateSession model_name -> do
(out :: String) <- lift $ createSession model_name
sendTextData $ object ["new_connection" .= makeJson out]
ProcessImage sid image params time -> do
liftIO $ print "inside process image"
(out :: String) <- lift $ processImage sid image params time
liftIO $ print out
sendTextData $ pack $"{\"process_image\" : " <> out <> "}"
)
getWebSocketR :: Handler ()
getWebSocketR = do
webSockets {- # SCC "the_websockets" #-} vmxWebSocket
return ()