core: update version response (#1819)

* core: update version response

* add simplexmq commit and version to version info

* refactor

apps/simplex-chat/Main.hs

@@ -5,7 +5,7 @@ module Main where
 import Control.Concurrent (threadDelay)
 import Data.Time.Clock (getCurrentTime)
 import Server
-import Simplex.Chat.Controller (versionNumber)
+import Simplex.Chat.Controller (versionNumber, versionString)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
 import Simplex.Chat.Terminal
@@ -36,7 +36,7 @@ welcome :: ChatOpts -> IO ()
 welcome ChatOpts {dbFilePrefix, networkConfig} =
   mapM_
     putStrLn
-    [ "SimpleX Chat v" ++ versionNumber,
+    [ versionString versionNumber,
       "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db",
       maybe
         "direct network connection - use `/network` command or `-x` CLI option to connect via SOCKS5 at :9050"

src/Simplex/Chat.hs

@@ -1223,7 +1223,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)
 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,
@@ -344,7 +368,7 @@ data ChatResponse
   | CRFileTransferStatus (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
   | CRUserProfile {profile :: Profile}
   | CRUserProfileNoChange
-  | CRVersionInfo {version :: String, versionInfo :: CoreVersionInfo}
+  | CRVersionInfo {versionInfo :: CoreVersionInfo}
   | CRInvitation {connReqInvitation :: ConnReqInvitation}
   | CRSentConfirmation
   | CRSentInvitation {customUserProfile :: Maybe Profile}
@@ -557,7 +581,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

@@ -112,7 +112,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
   CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus
   CRUserProfile p -> viewUserProfile p
   CRUserProfileNoChange -> ["user profile did not change"]
-  CRVersionInfo _ _ -> [plain versionStr, plain updateStr]
+  CRVersionInfo info -> viewVersionInfo logLevel info
   CRChatCmdError e -> viewChatError logLevel e
   CRInvitation cReq -> viewConnReqInvitation cReq
   CRSentConfirmation -> ["confirmation sent!"]
@@ -1142,6 +1142,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