Merge branch 'master' into users

src/Simplex/Chat.hs

@@ -1310,7 +1310,7 @@ processChatCommand = \case
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
   QuitChat -> liftIO exitSuccess
-  ShowVersion -> pure $ CRVersionInfo versionNumber CoreVersionInfo {buildTimestamp = $(buildTimestampQ)}
+  ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) $(simplexmqCommitQ)
   DebugLocks -> do
     chatLockName <- atomically . tryReadTMVar =<< asks chatLock
     agentLocks <- withAgent debugAgentLocks

src/Simplex/Chat/Controller.hs

@@ -55,6 +55,7 @@ import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags, NtfServer)
 import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
@@ -63,8 +64,8 @@ import UnliftIO.STM
 versionNumber :: String
 versionNumber = showVersion SC.version
 
-versionStr :: String
-versionStr = "SimpleX Chat v" <> versionNumber
+versionString :: String -> String
+versionString version = "SimpleX Chat v" <> version
 
 updateStr :: String
 updateStr = "To update run: curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash"
@@ -74,6 +75,29 @@ buildTimestampQ = do
   s <- formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") <$> runIO getCurrentTime
   [|fromString s|]
 
+simplexmqCommitQ :: Q Exp
+simplexmqCommitQ = do
+  s <- either error B.unpack . A.parseOnly commitHashP <$> runIO (B.readFile "./cabal.project")
+  [|fromString s|]
+  where
+    commitHashP :: A.Parser ByteString
+    commitHashP =
+      A.manyTill' A.anyChar "location: https://github.com/simplex-chat/simplexmq.git"
+        *> A.takeWhile (== ' ')
+        *> A.endOfLine
+        *> A.takeWhile (== ' ')
+        *> "tag: "
+        *> A.takeWhile (A.notInClass " \r\n")
+
+coreVersionInfo :: String -> String -> CoreVersionInfo
+coreVersionInfo buildTimestamp simplexmqCommit =
+  CoreVersionInfo
+    { version = versionNumber,
+      buildTimestamp,
+      simplexmqVersion = simplexMQVersion,
+      simplexmqCommit
+    }
+
 data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
     yesToMigrations :: Bool,
@@ -368,7 +392,7 @@ data ChatResponse
   | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
   | CRUserProfile {user :: User, profile :: Profile}
   | CRUserProfileNoChange {user :: User}
-  | CRVersionInfo {version :: String, versionInfo :: CoreVersionInfo}
+  | CRVersionInfo {versionInfo :: CoreVersionInfo}
   | CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation}
   | CRSentConfirmation {user :: User}
   | CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
@@ -581,7 +605,10 @@ data ChatLogLevel = CLLDebug | CLLInfo | CLLWarning | CLLError | CLLImportant
   deriving (Eq, Ord, Show)
 
 data CoreVersionInfo = CoreVersionInfo
-  { buildTimestamp :: String
+  { version :: String,
+    buildTimestamp :: String,
+    simplexmqVersion :: String,
+    simplexmqCommit :: String
   }
   deriving (Show, Generic)
 

src/Simplex/Chat/Options.hs

@@ -17,7 +17,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Numeric.Natural (Natural)
 import Options.Applicative
-import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionStr)
+import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionNumber, versionString)
 import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
@@ -232,5 +232,6 @@ getChatOpts appDir defaultDbFileName =
       (helper <*> versionOption <*> chatOpts appDir defaultDbFileName)
       (header versionStr <> fullDesc <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server")
   where
+    versionStr = versionString versionNumber
     versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
     versionAndUpdate = versionStr <> "\n" <> updateStr

src/Simplex/Chat/View.hs

@@ -114,7 +114,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
   CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
   CRUserProfile u p -> ttyUser u $ viewUserProfile p
   CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
-  CRVersionInfo _ _ -> [plain versionStr, plain updateStr]
+  CRVersionInfo info -> viewVersionInfo logLevel info
   CRInvitation u cReq -> ttyUser u $ viewConnReqInvitation cReq
   CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
   CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
@@ -1161,6 +1161,15 @@ instance ToJSON WCallCommand where
   toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "WCCall"
   toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "WCCall"
 
+viewVersionInfo :: ChatLogLevel -> CoreVersionInfo -> [StyledString]
+viewVersionInfo logLevel CoreVersionInfo {version, buildTimestamp, simplexmqVersion, simplexmqCommit} =
+  map plain $
+    if logLevel <= CLLInfo
+      then [versionString version <> parens buildTimestamp, updateStr, "simplexmq: " <> simplexmqVersion <> parens simplexmqCommit]
+      else [versionString version, updateStr]
+  where
+    parens s = " (" <> s <> ")"
+
 viewChatError :: ChatLogLevel -> ChatError -> [StyledString]
 viewChatError logLevel = \case
   ChatError err -> case err of