Fix string encodings.

Previously we used the Binary instance for Text to serialise the event
name. This is wrong.

We now first encode to UTF-8 and use this in the eventlog encoding.

Author: bgamari

src/GHC/RTS/Events/Binary.hs

@@ -916,8 +916,9 @@ putHeader (Header ets) = do
         putMarker EVENT_ET_BEGIN
         putType n
         putE $ fromMaybe 0xffff msz
-        putE (fromIntegral $ T.length d :: EventTypeDescLen)
-        putE d
+        let d' = TE.encodeUtf8 d
+        putE (fromIntegral $ B.length d' :: EventTypeDescLen)
+        putByteString d'
         -- the event type header allows for extra data, which we don't use:
         putE (0 :: Word32)
         putMarker EVENT_ET_END
@@ -1136,9 +1137,10 @@ putEventSpec (WakeupThread t c) = do
     putCap c
 
 putEventSpec (ThreadLabel t l) = do
-    putE (fromIntegral (T.length l) + sz_tid :: Word16)
+    let l' = TE.encodeUtf8 l
+    putE (fromIntegral (B.length l') + sz_tid :: Word16)
     putE t
-    putE l
+    putByteString l'
 
 putEventSpec Shutdown =
     return ()
@@ -1245,21 +1247,24 @@ putEventSpec (CapsetRemoveCap cs cp) = do
     putCap cp
 
 putEventSpec (RtsIdentifier cs rts) = do
-    putE (fromIntegral (T.length rts) + sz_capset :: Word16)
+    let rts' = TE.encodeUtf8 rts
+    putE (fromIntegral (B.length rts') + sz_capset :: Word16)
     putE cs
-    putE rts
+    putByteString rts'
 
 putEventSpec (ProgramArgs cs as) = do
-    let sz_args = sum $ map ((+ 1) {- for \0 -} . T.length) as
+    let as' = map TE.encodeUtf8 as
+    let sz_args = sum (map ((+ 1) {- for \0 -} . B.length) as') - 1
     putE (fromIntegral sz_args + sz_capset :: Word16)
     putE cs
-    mapM_ putE (intersperse "\0" as)
+    mapM_ putByteString (intersperse "\0" as')
 
 putEventSpec (ProgramEnv cs es) = do
-    let sz_env = sum $ map ((+ 1) {- for \0 -} . T.length) es
+    let es' = map TE.encodeUtf8 es
+    let sz_env = sum (map ((+ 1) {- for \0 -} . B.length) es') - 1
     putE (fromIntegral sz_env + sz_capset :: Word16)
     putE cs
-    mapM_ putE $ intersperse "\0" es
+    mapM_ putByteString $ intersperse "\0" es'
 
 putEventSpec (OsProcessPid cs pid) = do
     putE cs
@@ -1275,16 +1280,19 @@ putEventSpec (WallClockTime cs sec nsec) = do
     putE nsec
 
 putEventSpec (Message s) = do
-    putE (fromIntegral (T.length s) :: Word16)
-    putE s
+    let s' = TE.encodeUtf8 s
+    putE (fromIntegral (B.length s') :: Word16)
+    putByteString s'
 
 putEventSpec (UserMessage s) = do
-    putE (fromIntegral (T.length s) :: Word16)
-    putE s
+    let s' = TE.encodeUtf8 s
+    putE (fromIntegral (B.length s') :: Word16)
+    putByteString s'
 
 putEventSpec (UserMarker s) = do
-    putE (fromIntegral (T.length s) :: Word16)
-    putE s
+    let s' = TE.encodeUtf8 s
+    putE (fromIntegral (B.length s') :: Word16)
+    putByteString s'
 
 putEventSpec (UnknownEvent {}) = error "putEventSpec UnknownEvent"
 
@@ -1388,9 +1396,10 @@ putEventSpec MerCapSleeping = return ()
 putEventSpec MerCallingMain = return ()
 
 putEventSpec PerfName{..} = do
-    putE (fromIntegral (T.length name) + sz_perf_num :: Word16)
+    let name' = TE.encodeUtf8 name
+    putE (fromIntegral (B.length name') + sz_perf_num :: Word16)
     putE perfNum
-    putE name
+    putByteString name'
 
 putEventSpec PerfCounter{..} = do
     putE perfNum