SimpleX-Chat/src/Simplex/Chat/View.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.Chat.View
  ( printToView,
    showInvitation,
    showSentConfirmation,
    showSentInvitation,
    showInvalidConnReq,
    showChatError,
    showContactDeleted,
    showContactGroups,
    showContactsList,
    showContactConnected,
    showContactDisconnected,
    showContactAnotherClient,
    showContactSubscribed,
    showContactSubError,
    showUserContactLinkCreated,
    showUserContactLinkDeleted,
    showUserContactLink,
    showReceivedContactRequest,
    showAcceptingContactRequest,
    showContactRequestRejected,
    showUserContactLinkSubscribed,
    showUserContactLinkSubError,
    showGroupSubscribed,
    showGroupEmpty,
    showGroupRemoved,
    showGroupInvitation,
    showMemberSubError,
    showReceivedMessage,
    showReceivedGroupMessage,
    showSentMessage,
    showSentGroupMessage,
    showSentFileInvitation,
    showSentGroupFileInvitation,
    showSentFileInfo,
    showSndFileStart,
    showSndFileComplete,
    showSndFileCancelled,
    showSndGroupFileCancelled,
    showSndFileRcvCancelled,
    receivedFileInvitation,
    showRcvFileAccepted,
    showRcvFileStart,
    showRcvFileComplete,
    showRcvFileCancelled,
    showRcvFileSndCancelled,
    showFileTransferStatus,
    showSndFileSubError,
    showRcvFileSubError,
    showGroupCreated,
    showGroupDeletedUser,
    showGroupDeleted,
    showSentGroupInvitation,
    showCannotResendInvitation,
    showReceivedGroupInvitation,
    showJoinedGroupMember,
    showUserJoinedGroup,
    showJoinedGroupMemberConnecting,
    showConnectedToGroupMember,
    showDeletedMember,
    showDeletedMemberUser,
    showLeftMemberUser,
    showLeftMember,
    showGroupMembers,
    showGroupsList,
    showContactsMerged,
    showUserProfile,
    showUserProfileUpdated,
    showContactUpdated,
    showMessageError,
    safeDecodeUtf8,
    msgPlain,
    clientVersionInfo,
  )
where

import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.ByteString.Char8 (ByteString)
import Data.Composition ((.:), (.:.))
import Data.Function (on)
import Data.Int (Int64)
import Data.List (groupBy, intersperse, sort, sortOn)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (DiffTime, UTCTime)
import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (TimeZone, ZonedTime, getCurrentTimeZone, getZonedTime, localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime, zonedTimeToLocalTime)
import Numeric (showFFloat)
import Simplex.Chat.Controller
import Simplex.Chat.Markdown
import Simplex.Chat.Store (StoreError (..))
import Simplex.Chat.Styled
import Simplex.Chat.Terminal (printToTerminal)
import Simplex.Chat.Types
import Simplex.Chat.Util (safeDecodeUtf8)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Encoding.String
import qualified Simplex.Messaging.Protocol as SMP
import System.Console.ANSI.Types

type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)

showInvitation :: ChatReader m => ConnReqInvitation -> m ()
showInvitation = printToView . connReqInvitation_

showSentConfirmation :: ChatReader m => m ()
showSentConfirmation = printToView ["confirmation sent!"]

showSentInvitation :: ChatReader m => m ()
showSentInvitation = printToView ["connection request sent!"]

showInvalidConnReq :: ChatReader m => m ()
showInvalidConnReq =
  printToView
    [ "Connection link is invalid!",
      "Possibly, it was created in a newer version (to check version: " <> highlight' "/v" <> ")",
      "To upgrade (Linux/Mac):",
      "curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash"
    ]

showChatError :: ChatReader m => ChatError -> m ()
showChatError = printToView . chatError

showContactDeleted :: ChatReader m => ContactName -> m ()
showContactDeleted = printToView . contactDeleted

showContactGroups :: ChatReader m => ContactName -> [GroupName] -> m ()
showContactGroups = printToView .: contactGroups

showContactsList :: ChatReader m => [Contact] -> m ()
showContactsList = printToView . contactsList

showContactConnected :: ChatReader m => Contact -> m ()
showContactConnected = printToView . contactConnected

showContactDisconnected :: ChatReader m => ContactName -> m ()
showContactDisconnected = printToView . contactDisconnected

showContactAnotherClient :: ChatReader m => ContactName -> m ()
showContactAnotherClient = printToView . contactAnotherClient

showContactSubscribed :: ChatReader m => ContactName -> m ()
showContactSubscribed = printToView . contactSubscribed

showContactSubError :: ChatReader m => ContactName -> ChatError -> m ()
showContactSubError = printToView .: contactSubError

showUserContactLinkCreated :: ChatReader m => ConnReqContact -> m ()
showUserContactLinkCreated = printToView . userContactLinkCreated

showUserContactLinkDeleted :: ChatReader m => m ()
showUserContactLinkDeleted = printToView userContactLinkDeleted

showUserContactLink :: ChatReader m => ConnReqContact -> m ()
showUserContactLink = printToView . userContactLink

showReceivedContactRequest :: ChatReader m => ContactName -> Profile -> m ()
showReceivedContactRequest = printToView .: receivedContactRequest

showAcceptingContactRequest :: ChatReader m => ContactName -> m ()
showAcceptingContactRequest = printToView . acceptingContactRequest

showContactRequestRejected :: ChatReader m => ContactName -> m ()
showContactRequestRejected = printToView . contactRequestRejected

showUserContactLinkSubscribed :: ChatReader m => m ()
showUserContactLinkSubscribed = printToView ["Your address is active! To show: " <> highlight' "/sa"]

showUserContactLinkSubError :: ChatReader m => ChatError -> m ()
showUserContactLinkSubError = printToView . userContactLinkSubError

showGroupSubscribed :: ChatReader m => Group -> m ()
showGroupSubscribed = printToView . groupSubscribed

showGroupEmpty :: ChatReader m => Group -> m ()
showGroupEmpty = printToView . groupEmpty

showGroupRemoved :: ChatReader m => Group -> m ()
showGroupRemoved = printToView . groupRemoved

showGroupInvitation :: ChatReader m => Group -> m ()
showGroupInvitation Group {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
  printToView [groupInvitation ldn fullName]

showMemberSubError :: ChatReader m => GroupName -> ContactName -> ChatError -> m ()
showMemberSubError = printToView .:. memberSubError

showReceivedMessage :: ChatReader m => ContactName -> UTCTime -> [StyledString] -> MsgIntegrity -> m ()
showReceivedMessage = showReceivedMessage_ . ttyFromContact

showReceivedGroupMessage :: ChatReader m => GroupName -> ContactName -> UTCTime -> [StyledString] -> MsgIntegrity -> m ()
showReceivedGroupMessage = showReceivedMessage_ .: ttyFromGroup

showReceivedMessage_ :: ChatReader m => StyledString -> UTCTime -> [StyledString] -> MsgIntegrity -> m ()
showReceivedMessage_ from utcTime msg mOk = printToView =<< liftIO (receivedMessage from utcTime msg mOk)

showSentMessage :: ChatReader m => ContactName -> ByteString -> m ()
showSentMessage = showSentMessage_ . ttyToContact

showSentGroupMessage :: ChatReader m => GroupName -> ByteString -> m ()
showSentGroupMessage = showSentMessage_ . ttyToGroup

showSentMessage_ :: ChatReader m => StyledString -> ByteString -> m ()
showSentMessage_ to msg = printToView =<< liftIO (sentMessage to msg)

showSentFileInvitation :: ChatReader m => ContactName -> FilePath -> m ()
showSentFileInvitation = showSentFileInvitation_ . ttyToContact

showSentGroupFileInvitation :: ChatReader m => GroupName -> FilePath -> m ()
showSentGroupFileInvitation = showSentFileInvitation_ . ttyToGroup

showSentFileInvitation_ :: ChatReader m => StyledString -> FilePath -> m ()
showSentFileInvitation_ to filePath = printToView =<< liftIO (sentFileInvitation to filePath)

showSentFileInfo :: ChatReader m => Int64 -> m ()
showSentFileInfo = printToView . sentFileInfo

showSndFileStart :: ChatReader m => SndFileTransfer -> m ()
showSndFileStart = printToView . sndFileStart

showSndFileComplete :: ChatReader m => SndFileTransfer -> m ()
showSndFileComplete = printToView . sndFileComplete

showSndFileCancelled :: ChatReader m => SndFileTransfer -> m ()
showSndFileCancelled = printToView . sndFileCancelled

showSndGroupFileCancelled :: ChatReader m => [SndFileTransfer] -> m ()
showSndGroupFileCancelled = printToView . sndGroupFileCancelled

showSndFileRcvCancelled :: ChatReader m => SndFileTransfer -> m ()
showSndFileRcvCancelled = printToView . sndFileRcvCancelled

showRcvFileAccepted :: ChatReader m => RcvFileTransfer -> FilePath -> m ()
showRcvFileAccepted = printToView .: rcvFileAccepted

showRcvFileStart :: ChatReader m => RcvFileTransfer -> m ()
showRcvFileStart = printToView . rcvFileStart

showRcvFileComplete :: ChatReader m => RcvFileTransfer -> m ()
showRcvFileComplete = printToView . rcvFileComplete

showRcvFileCancelled :: ChatReader m => RcvFileTransfer -> m ()
showRcvFileCancelled = printToView . rcvFileCancelled

showRcvFileSndCancelled :: ChatReader m => RcvFileTransfer -> m ()
showRcvFileSndCancelled = printToView . rcvFileSndCancelled

showFileTransferStatus :: ChatReader m => (FileTransfer, [Integer]) -> m ()
showFileTransferStatus = printToView . fileTransferStatus

showSndFileSubError :: ChatReader m => SndFileTransfer -> ChatError -> m ()
showSndFileSubError = printToView .: sndFileSubError

showRcvFileSubError :: ChatReader m => RcvFileTransfer -> ChatError -> m ()
showRcvFileSubError = printToView .: rcvFileSubError

showGroupCreated :: ChatReader m => Group -> m ()
showGroupCreated = printToView . groupCreated

showGroupDeletedUser :: ChatReader m => GroupName -> m ()
showGroupDeletedUser = printToView . groupDeletedUser

showGroupDeleted :: ChatReader m => GroupName -> GroupMember -> m ()
showGroupDeleted = printToView .: groupDeleted

showSentGroupInvitation :: ChatReader m => GroupName -> ContactName -> m ()
showSentGroupInvitation = printToView .: sentGroupInvitation

showCannotResendInvitation :: ChatReader m => GroupName -> ContactName -> m ()
showCannotResendInvitation = printToView .: cannotResendInvitation

showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> GroupMemberRole -> m ()
showReceivedGroupInvitation = printToView .:. receivedGroupInvitation

showJoinedGroupMember :: ChatReader m => GroupName -> GroupMember -> m ()
showJoinedGroupMember = printToView .: joinedGroupMember

showUserJoinedGroup :: ChatReader m => GroupName -> m ()
showUserJoinedGroup = printToView . userJoinedGroup

showJoinedGroupMemberConnecting :: ChatReader m => GroupName -> GroupMember -> GroupMember -> m ()
showJoinedGroupMemberConnecting = printToView .:. joinedGroupMemberConnecting

showConnectedToGroupMember :: ChatReader m => GroupName -> GroupMember -> m ()
showConnectedToGroupMember = printToView .: connectedToGroupMember

showDeletedMember :: ChatReader m => GroupName -> Maybe GroupMember -> Maybe GroupMember -> m ()
showDeletedMember = printToView .:. deletedMember

showDeletedMemberUser :: ChatReader m => GroupName -> GroupMember -> m ()
showDeletedMemberUser = printToView .: deletedMemberUser

showLeftMemberUser :: ChatReader m => GroupName -> m ()
showLeftMemberUser = printToView . leftMemberUser

showLeftMember :: ChatReader m => GroupName -> GroupMember -> m ()
showLeftMember = printToView .: leftMember

showGroupMembers :: ChatReader m => Group -> m ()
showGroupMembers = printToView . groupMembers

showGroupsList :: ChatReader m => [(GroupName, Text, GroupMemberStatus)] -> m ()
showGroupsList = printToView . groupsList

showContactsMerged :: ChatReader m => Contact -> Contact -> m ()
showContactsMerged = printToView .: contactsMerged

showUserProfile :: ChatReader m => Profile -> m ()
showUserProfile = printToView . userProfile

showUserProfileUpdated :: ChatReader m => User -> User -> m ()
showUserProfileUpdated = printToView .: userProfileUpdated

showContactUpdated :: ChatReader m => Contact -> Contact -> m ()
showContactUpdated = printToView .: contactUpdated

showMessageError :: ChatReader m => Text -> Text -> m ()
showMessageError = printToView .: messageError

connReqInvitation_ :: ConnReqInvitation -> [StyledString]
connReqInvitation_ cReq =
  [ "pass this invitation link to your contact (via another channel): ",
    "",
    (plain . strEncode) cReq,
    "",
    "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
  ]

contactDeleted :: ContactName -> [StyledString]
contactDeleted c = [ttyContact c <> ": contact is deleted"]

contactGroups :: ContactName -> [GroupName] -> [StyledString]
contactGroups c gNames = [ttyContact c <> ": contact cannot be deleted, it is a member of the group(s) " <> ttyGroups gNames]
  where
    ttyGroups :: [GroupName] -> StyledString
    ttyGroups [] = ""
    ttyGroups [g] = ttyGroup g
    ttyGroups (g : gs) = ttyGroup g <> ", " <> ttyGroups gs

contactsList :: [Contact] -> [StyledString]
contactsList =
  let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
   in map ttyFullContact . sortOn ldn

contactConnected :: Contact -> [StyledString]
contactConnected ct = [ttyFullContact ct <> ": contact is connected"]

contactDisconnected :: ContactName -> [StyledString]
contactDisconnected c = [ttyContact c <> ": disconnected from server (messages will be queued)"]

contactAnotherClient :: ContactName -> [StyledString]
contactAnotherClient c = [ttyContact c <> ": contact is connected to another client"]

contactSubscribed :: ContactName -> [StyledString]
contactSubscribed c = [ttyContact c <> ": connected to server"]

contactSubError :: ContactName -> ChatError -> [StyledString]
contactSubError c e = [ttyContact c <> ": contact error " <> sShow e]

userContactLinkCreated :: ConnReqContact -> [StyledString]
userContactLinkCreated = connReqContact_ "Your new chat address is created!"

userContactLinkDeleted :: [StyledString]
userContactLinkDeleted =
  [ "Your chat address is deleted - accepted contacts will remain connected.",
    "To create a new chat address use " <> highlight' "/ad"
  ]

userContactLink :: ConnReqContact -> [StyledString]
userContactLink = connReqContact_ "Your chat address:"

connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
connReqContact_ intro cReq =
  [ intro,
    "",
    (plain . strEncode) cReq,
    "",
    "Anybody can send you contact requests with: " <> highlight' "/c <contact_link_above>",
    "to show it again: " <> highlight' "/sa",
    "to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
  ]

receivedContactRequest :: ContactName -> Profile -> [StyledString]
receivedContactRequest c Profile {fullName} =
  [ ttyFullName c fullName <> " wants to connect to you!",
    "to accept: " <> highlight ("/ac " <> c),
    "to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)"
  ]

acceptingContactRequest :: ContactName -> [StyledString]
acceptingContactRequest c = [ttyContact c <> ": accepting contact request..."]

contactRequestRejected :: ContactName -> [StyledString]
contactRequestRejected c = [ttyContact c <> ": contact request rejected"]

userContactLinkSubError :: ChatError -> [StyledString]
userContactLinkSubError e =
  [ "user address error: " <> sShow e,
    "to delete your address: " <> highlight' "/da"
  ]

groupSubscribed :: Group -> [StyledString]
groupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"]

groupEmpty :: Group -> [StyledString]
groupEmpty g = [ttyFullGroup g <> ": group is empty"]

groupRemoved :: Group -> [StyledString]
groupRemoved g = [ttyFullGroup g <> ": you are no longer a member or group deleted"]

memberSubError :: GroupName -> ContactName -> ChatError -> [StyledString]
memberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> sShow e]

groupCreated :: Group -> [StyledString]
groupCreated g@Group {localDisplayName} =
  [ "group " <> ttyFullGroup g <> " is created",
    "use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
  ]

groupDeletedUser :: GroupName -> [StyledString]
groupDeletedUser g = groupDeleted_ g Nothing

groupDeleted :: GroupName -> GroupMember -> [StyledString]
groupDeleted g m = groupDeleted_ g (Just m) <> ["use " <> highlight ("/d #" <> g) <> " to delete the local copy of the group"]

groupDeleted_ :: GroupName -> Maybe GroupMember -> [StyledString]
groupDeleted_ g m = [ttyGroup g <> ": " <> memberOrUser m <> " deleted the group"]

sentGroupInvitation :: GroupName -> ContactName -> [StyledString]
sentGroupInvitation g c = ["invitation to join the group " <> ttyGroup g <> " sent to " <> ttyContact c]

cannotResendInvitation :: GroupName -> ContactName -> [StyledString]
cannotResendInvitation g c =
  [ ttyContact c <> " is already invited to group " <> ttyGroup g,
    "to re-send invitation: " <> highlight ("/rm " <> g <> " " <> c) <> ", " <> highlight ("/a " <> g <> " " <> c)
  ]

receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
receivedGroupInvitation g@Group {localDisplayName} c role =
  [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (strEncode role),
    "use " <> highlight ("/j " <> localDisplayName) <> " to accept"
  ]

joinedGroupMember :: GroupName -> GroupMember -> [StyledString]
joinedGroupMember g m = [ttyGroup g <> ": " <> ttyMember m <> " joined the group "]

userJoinedGroup :: GroupName -> [StyledString]
userJoinedGroup g = [ttyGroup g <> ": you joined the group"]

joinedGroupMemberConnecting :: GroupName -> GroupMember -> GroupMember -> [StyledString]
joinedGroupMemberConnecting g host m = [ttyGroup g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]

connectedToGroupMember :: GroupName -> GroupMember -> [StyledString]
connectedToGroupMember g m = [ttyGroup g <> ": " <> connectedMember m <> " is connected"]

deletedMember :: GroupName -> Maybe GroupMember -> Maybe GroupMember -> [StyledString]
deletedMember g by m = [ttyGroup g <> ": " <> memberOrUser by <> " removed " <> memberOrUser m <> " from the group"]

deletedMemberUser :: GroupName -> GroupMember -> [StyledString]
deletedMemberUser g by = deletedMember g (Just by) Nothing <> groupPreserved g

leftMemberUser :: GroupName -> [StyledString]
leftMemberUser g = leftMember_ g Nothing <> groupPreserved g

leftMember :: GroupName -> GroupMember -> [StyledString]
leftMember g m = leftMember_ g (Just m)

leftMember_ :: GroupName -> Maybe GroupMember -> [StyledString]
leftMember_ g m = [ttyGroup g <> ": " <> memberOrUser m <> " left the group"]

groupPreserved :: GroupName -> [StyledString]
groupPreserved g = ["use " <> highlight ("/d #" <> g) <> " to delete the group"]

memberOrUser :: Maybe GroupMember -> StyledString
memberOrUser = maybe "you" ttyMember

connectedMember :: GroupMember -> StyledString
connectedMember m = case memberCategory m of
  GCPreMember -> "member " <> ttyFullMember m
  GCPostMember -> "new member " <> ttyMember m -- without fullName as as it was shown in joinedGroupMemberConnecting
  _ -> "member " <> ttyMember m -- these case is not used

groupMembers :: Group -> [StyledString]
groupMembers Group {membership, members} = map groupMember . filter (not . removedOrLeft) $ membership : members
  where
    removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
    groupMember m = ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
    role m = plain . strEncode $ memberRole (m :: GroupMember)
    category m = case memberCategory m of
      GCUserMember -> "you, "
      GCInviteeMember -> "invited, "
      GCHostMember -> "host, "
      _ -> ""
    status m = case memberStatus m of
      GSMemRemoved -> "removed"
      GSMemLeft -> "left"
      GSMemInvited -> "not yet joined"
      GSMemConnected -> "connected"
      GSMemComplete -> "connected"
      GSMemCreator -> "created group"
      _ -> ""

groupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString]
groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
groupsList gs = map groupSS $ sort gs
  where
    groupSS (displayName, fullName, GSMemInvited) = groupInvitation displayName fullName
    groupSS (displayName, fullName, _) = ttyGroup displayName <> optFullName displayName fullName

groupInvitation :: GroupName -> Text -> StyledString
groupInvitation displayName fullName =
  highlight ("#" <> displayName)
    <> optFullName displayName fullName
    <> " - you are invited ("
    <> highlight ("/j " <> displayName)
    <> " to join, "
    <> highlight ("/d #" <> displayName)
    <> " to delete invitation)"

contactsMerged :: Contact -> Contact -> [StyledString]
contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} =
  [ "contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1,
    "use " <> ttyToContact c1 <> highlight' "<message>" <> " to send messages"
  ]

userProfile :: Profile -> [StyledString]
userProfile Profile {displayName, fullName} =
  [ "user profile: " <> ttyFullName displayName fullName,
    "use " <> highlight' "/p <display name> [<full name>]" <> " to change it",
    "(the updated profile will be sent to all your contacts)"
  ]

userProfileUpdated :: User -> User -> [StyledString]
userProfileUpdated
  User {localDisplayName = n, profile = Profile {fullName}}
  User {localDisplayName = n', profile = Profile {fullName = fullName'}}
    | n == n' && fullName == fullName' = []
    | n == n' = ["user full name " <> (if T.null fullName' || fullName' == n' then "removed" else "changed to " <> plain fullName') <> notified]
    | otherwise = ["user profile is changed to " <> ttyFullName n' fullName' <> notified]
    where
      notified = " (your contacts are notified)"

contactUpdated :: Contact -> Contact -> [StyledString]
contactUpdated
  Contact {localDisplayName = n, profile = Profile {fullName}}
  Contact {localDisplayName = n', profile = Profile {fullName = fullName'}}
    | n == n' && fullName == fullName' = []
    | n == n' = ["contact " <> ttyContact n <> fullNameUpdate]
    | otherwise =
      [ "contact " <> ttyContact n <> " changed to " <> ttyFullName n' fullName',
        "use " <> ttyToContact n' <> highlight' "<message>" <> " to send messages"
      ]
    where
      fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'

messageError :: Text -> Text -> [StyledString]
messageError prefix err = [plain prefix <> ": " <> plain err]

receivedMessage :: StyledString -> UTCTime -> [StyledString] -> MsgIntegrity -> IO [StyledString]
receivedMessage from utcTime msg mOk = do
  t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime
  pure $ prependFirst (t <> " " <> from) msg ++ showIntegrity mOk
  where
    formatUTCTime :: TimeZone -> ZonedTime -> StyledString
    formatUTCTime localTz currentTime =
      let localTime = utcToLocalTime localTz utcTime
          format =
            if (localDay localTime < localDay (zonedTimeToLocalTime currentTime))
              && (timeOfDayToTime (localTimeOfDay localTime) > (6 * 60 * 60 :: DiffTime))
              then "%m-%d" -- if message is from yesterday or before and 6 hours has passed since midnight
              else "%H:%M"
       in styleTime $ formatTime defaultTimeLocale format localTime
    showIntegrity :: MsgIntegrity -> [StyledString]
    showIntegrity MsgOk = []
    showIntegrity (MsgError err) = msgError $ case err of
      MsgSkipped fromId toId ->
        "skipped message ID " <> show fromId
          <> if fromId == toId then "" else ".." <> show toId
      MsgBadId msgId -> "unexpected message ID " <> show msgId
      MsgBadHash -> "incorrect message hash"
      MsgDuplicate -> "duplicate message ID"
    msgError :: String -> [StyledString]
    msgError s = [styled (Colored Red) s]

sentMessage :: StyledString -> ByteString -> IO [StyledString]
sentMessage to msg = sendWithTime_ to . msgPlain $ safeDecodeUtf8 msg

sentFileInvitation :: StyledString -> FilePath -> IO [StyledString]
sentFileInvitation to f = sendWithTime_ ("/f " <> to) [ttyFilePath f]

sendWithTime_ :: StyledString -> [StyledString] -> IO [StyledString]
sendWithTime_ to styledMsg = do
  time <- formatTime defaultTimeLocale "%H:%M" <$> getZonedTime
  pure $ prependFirst (styleTime time <> " " <> to) styledMsg

prependFirst :: StyledString -> [StyledString] -> [StyledString]
prependFirst s [] = [s]
prependFirst s (s' : ss) = (s <> s') : ss

msgPlain :: Text -> [StyledString]
msgPlain = map styleMarkdownText . T.lines

sentFileInfo :: Int64 -> [StyledString]
sentFileInfo fileId =
  ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]

sndFileStart :: SndFileTransfer -> [StyledString]
sndFileStart = sendingFile_ "started"

sndFileComplete :: SndFileTransfer -> [StyledString]
sndFileComplete = sendingFile_ "completed"

sndFileCancelled :: SndFileTransfer -> [StyledString]
sndFileCancelled = sendingFile_ "cancelled"

sndGroupFileCancelled :: [SndFileTransfer] -> [StyledString]
sndGroupFileCancelled fts =
  case filter (\SndFileTransfer {fileStatus = s} -> s /= FSCancelled && s /= FSComplete) fts of
    [] -> ["sending file can't be cancelled"]
    ts@(ft : _) -> ["cancelled sending " <> sndFile ft <> " to " <> listMembers ts]

sendingFile_ :: StyledString -> SndFileTransfer -> [StyledString]
sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
  [status <> " sending " <> sndFile ft <> " to " <> ttyContact c]

sndFileRcvCancelled :: SndFileTransfer -> [StyledString]
sndFileRcvCancelled ft@SndFileTransfer {recipientDisplayName = c} =
  [ttyContact c <> " cancelled receiving " <> sndFile ft]

sndFile :: SndFileTransfer -> StyledString
sndFile SndFileTransfer {fileId, fileName} = fileTransfer fileId fileName

receivedFileInvitation :: RcvFileTransfer -> [StyledString]
receivedFileInvitation RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
  [ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
    "use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
  ]

humanReadableSize :: Integer -> StyledString
humanReadableSize size
  | size < kB = sShow size <> " bytes"
  | size < mB = hrSize kB "KiB"
  | size < gB = hrSize mB "MiB"
  | otherwise = hrSize gB "GiB"
  where
    hrSize sB name = plain $ unwords [showFFloat (Just 1) (fromIntegral size / (fromIntegral sB :: Double)) "", name]
    kB = 1024
    mB = kB * 1024
    gB = mB * 1024

rcvFileAccepted :: RcvFileTransfer -> FilePath -> [StyledString]
rcvFileAccepted RcvFileTransfer {fileId, senderDisplayName = c} filePath =
  ["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath]

rcvFileStart :: RcvFileTransfer -> [StyledString]
rcvFileStart = receivingFile_ "started"

rcvFileComplete :: RcvFileTransfer -> [StyledString]
rcvFileComplete = receivingFile_ "completed"

rcvFileCancelled :: RcvFileTransfer -> [StyledString]
rcvFileCancelled = receivingFile_ "cancelled"

receivingFile_ :: StyledString -> RcvFileTransfer -> [StyledString]
receivingFile_ status ft@RcvFileTransfer {senderDisplayName = c} =
  [status <> " receiving " <> rcvFile ft <> " from " <> ttyContact c]

rcvFileSndCancelled :: RcvFileTransfer -> [StyledString]
rcvFileSndCancelled ft@RcvFileTransfer {senderDisplayName = c} =
  [ttyContact c <> " cancelled sending " <> rcvFile ft]

rcvFile :: RcvFileTransfer -> StyledString
rcvFile RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} = fileTransfer fileId fileName

fileTransfer :: Int64 -> String -> StyledString
fileTransfer fileId fileName = "file " <> sShow fileId <> " (" <> ttyFilePath fileName <> ")"

fileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
fileTransferStatus (FTSnd [ft@SndFileTransfer {fileStatus, fileSize, chunkSize}], chunksNum) =
  ["sending " <> sndFile ft <> " " <> sndStatus]
  where
    sndStatus = case fileStatus of
      FSNew -> "not accepted yet"
      FSAccepted -> "just started"
      FSConnected -> "progress " <> fileProgress chunksNum chunkSize fileSize
      FSComplete -> "complete"
      FSCancelled -> "cancelled"
fileTransferStatus (FTSnd [], _) = ["no file transfers (empty group)"]
fileTransferStatus (FTSnd fts@(ft : _), chunksNum) =
  case concatMap membersTransferStatus $ groupBy ((==) `on` fs) $ sortOn fs fts of
    [membersStatus] -> ["sending " <> sndFile ft <> " " <> membersStatus]
    membersStatuses -> ("sending " <> sndFile ft <> ": ") : map ("  " <>) membersStatuses
  where
    fs = fileStatus :: SndFileTransfer -> FileStatus
    membersTransferStatus [] = []
    membersTransferStatus ts@(SndFileTransfer {fileStatus, fileSize, chunkSize} : _) = [sndStatus <> ": " <> listMembers ts]
      where
        sndStatus = case fileStatus of
          FSNew -> "not accepted"
          FSAccepted -> "just started"
          FSConnected -> "in progress (" <> sShow (sum chunksNum * chunkSize * 100 `div` (toInteger (length chunksNum) * fileSize)) <> "%)"
          FSComplete -> "complete"
          FSCancelled -> "cancelled"
fileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileSize}, fileStatus, chunkSize}, chunksNum) =
  ["receiving " <> rcvFile ft <> " " <> rcvStatus]
  where
    rcvStatus = case fileStatus of
      RFSNew -> "not accepted yet, use " <> highlight ("/fr " <> show fileId) <> " to receive file"
      RFSAccepted _ -> "just started"
      RFSConnected _ -> "progress " <> fileProgress chunksNum chunkSize fileSize
      RFSComplete RcvFileInfo {filePath} -> "complete, path: " <> plain filePath
      RFSCancelled RcvFileInfo {filePath} -> "cancelled, received part path: " <> plain filePath

listMembers :: [SndFileTransfer] -> StyledString
listMembers = mconcat . intersperse ", " . map (ttyContact . recipientDisplayName)

fileProgress :: [Integer] -> Integer -> Integer -> StyledString
fileProgress chunksNum chunkSize fileSize =
  sShow (sum chunksNum * chunkSize * 100 `div` fileSize) <> "% of " <> humanReadableSize fileSize

sndFileSubError :: SndFileTransfer -> ChatError -> [StyledString]
sndFileSubError SndFileTransfer {fileId, fileName} e =
  ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]

rcvFileSubError :: RcvFileTransfer -> ChatError -> [StyledString]
rcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e =
  ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]

chatError :: ChatError -> [StyledString]
chatError = \case
  ChatError err -> case err of
    CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
    CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
    CEGroupUserRole -> ["you have insufficient permissions for this group command"]
    CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
    CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> g)]
    CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"]
    CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
    CEGroupMemberNotFound c -> ["contact " <> ttyContact c <> " is not a group member"]
    CEGroupInternal s -> ["chat group bug: " <> plain s]
    CEFileNotFound f -> ["file not found: " <> plain f]
    CEFileAlreadyReceiving f -> ["file is already accepted: " <> plain f]
    CEFileAlreadyExists f -> ["file already exists: " <> plain f]
    CEFileRead f e -> ["cannot read file " <> plain f, sShow e]
    CEFileWrite f e -> ["cannot write file " <> plain f, sShow e]
    CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
    CEFileRcvChunk e -> ["error receiving file: " <> plain e]
    CEFileInternal e -> ["file error: " <> plain e]
    CEAgentVersion -> ["unsupported agent version"]
  -- e -> ["chat error: " <> sShow e]
  ChatErrorStore err -> case err of
    SEDuplicateName -> ["this display name is already used by user, contact or group"]
    SEContactNotFound c -> ["no contact " <> ttyContact c]
    SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"]
    SEGroupNotFound g -> ["no group " <> ttyGroup g]
    SEGroupAlreadyJoined -> ["you already joined this group"]
    SEFileNotFound fileId -> fileNotFound fileId
    SESndFileNotFound fileId -> fileNotFound fileId
    SERcvFileNotFound fileId -> fileNotFound fileId
    SEDuplicateContactLink -> ["you already have chat address, to show: " <> highlight' "/sa"]
    SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
    SEContactRequestNotFound c -> ["no contact request from " <> ttyContact c]
    e -> ["chat db error: " <> sShow e]
  ChatErrorAgent err -> case err of
    SMP SMP.AUTH -> ["error: this connection is deleted"]
    e -> ["smp agent error: " <> sShow e]
  ChatErrorMessage e -> ["chat message error: " <> sShow e]
  where
    fileNotFound fileId = ["file " <> sShow fileId <> " not found"]

printToView :: (MonadUnliftIO m, MonadReader ChatController m) => [StyledString] -> m ()
printToView s = asks chatTerminal >>= liftIO . (`printToTerminal` s)

ttyContact :: ContactName -> StyledString
ttyContact = styled (Colored Green)

ttyFullContact :: Contact -> StyledString
ttyFullContact Contact {localDisplayName, profile = Profile {fullName}} =
  ttyFullName localDisplayName fullName

ttyMember :: GroupMember -> StyledString
ttyMember GroupMember {localDisplayName} = ttyContact localDisplayName

ttyFullMember :: GroupMember -> StyledString
ttyFullMember GroupMember {localDisplayName, memberProfile = Profile {fullName}} =
  ttyFullName localDisplayName fullName

ttyFullName :: ContactName -> Text -> StyledString
ttyFullName c fullName = ttyContact c <> optFullName c fullName

ttyToContact :: ContactName -> StyledString
ttyToContact c = styled (Colored Cyan) $ "@" <> c <> " "

ttyFromContact :: ContactName -> StyledString
ttyFromContact c = styled (Colored Yellow) $ c <> "> "

ttyGroup :: GroupName -> StyledString
ttyGroup g = styled (Colored Blue) $ "#" <> g

ttyFullGroup :: Group -> StyledString
ttyFullGroup Group {localDisplayName, groupProfile = GroupProfile {fullName}} =
  ttyGroup localDisplayName <> optFullName localDisplayName fullName

ttyFromGroup :: GroupName -> ContactName -> StyledString
ttyFromGroup g c = styled (Colored Yellow) $ "#" <> g <> " " <> c <> "> "

ttyToGroup :: GroupName -> StyledString
ttyToGroup g = styled (Colored Cyan) $ "#" <> g <> " "

ttyFilePath :: FilePath -> StyledString
ttyFilePath = plain

optFullName :: ContactName -> Text -> StyledString
optFullName localDisplayName fullName
  | T.null fullName || localDisplayName == fullName = ""
  | otherwise = plain (" (" <> fullName <> ")")

highlight :: StyledFormat a => a -> StyledString
highlight = styled (Colored Cyan)

highlight' :: String -> StyledString
highlight' = highlight

styleTime :: String -> StyledString
styleTime = Styled [SetColor Foreground Vivid Black]

clientVersionInfo :: [StyledString]
clientVersionInfo = [plain versionStr, plain updateStr]