mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
core: calculate local item ts in view instead of having it in type (#2551)
This commit is contained in:
spaced4ndy
GitHub
parent
925813b14c
commit
fb72dfcdee
5 changed files with 101 additions and 113 deletions
|
|
@ -46,7 +46,7 @@ import Data.Text.Encoding (encodeUtf8)
|
|||
import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
|
||||
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
|
||||
import Data.Time.Clock.System (SystemTime, systemToUTCTime)
|
||||
import Data.Time.LocalTime (getCurrentTimeZone, getZonedTime)
|
||||
import Data.Time.LocalTime (getCurrentTimeZone)
|
||||
import Data.Word (Word32)
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
import Simplex.Chat.Archive
|
||||
|
|
@ -1260,7 +1260,7 @@ processChatCommand = \case
|
|||
saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc)
|
||||
)
|
||||
`catchError` (toView . CRChatError (Just user))
|
||||
CRBroadcastSent user mc (length cts) <$> liftIO getZonedTime
|
||||
CRBroadcastSent user mc (length cts) <$> liftIO getCurrentTime
|
||||
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
|
||||
|
|
@ -4420,10 +4420,9 @@ saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} conte
|
|||
|
||||
mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> UTCTime -> IO (ChatItem c d)
|
||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs currentTs = do
|
||||
tz <- getCurrentTimeZone
|
||||
let itemText = ciContentToText content
|
||||
itemStatus = ciCreateStatus content
|
||||
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) tz currentTs itemTs currentTs currentTs
|
||||
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs currentTs currentTs
|
||||
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
|
||||
|
||||
deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ import Data.List.NonEmpty (NonEmpty)
|
|||
import Data.Map.Strict (Map)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import Data.Time (NominalDiffTime, ZonedTime)
|
||||
import Data.Time (NominalDiffTime)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Version (showVersion)
|
||||
import GHC.Generics (Generic)
|
||||
|
|
@ -413,7 +413,7 @@ data ChatResponse
|
|||
| CRChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction}
|
||||
| CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
|
||||
| CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
|
||||
| CRBroadcastSent User MsgContent Int ZonedTime
|
||||
| CRBroadcastSent User MsgContent Int UTCTime
|
||||
| CRMsgIntegrityError {user :: User, msgError :: MsgErrorType}
|
||||
| CRCmdAccepted {corr :: CorrId}
|
||||
| CRCmdOk {user_ :: Maybe User}
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@ import Data.Text (Text)
|
|||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
|
||||
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
|
||||
import Data.Type.Equality
|
||||
import Data.Typeable (Typeable)
|
||||
import Database.SQLite.Simple.FromField (FromField (..))
|
||||
|
|
@ -341,19 +340,17 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
|||
itemTimed :: Maybe CITimed,
|
||||
itemLive :: Maybe Bool,
|
||||
editable :: Bool,
|
||||
localItemTs :: ZonedTime,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive tz currentTs itemTs createdAt updatedAt =
|
||||
let localItemTs = utcToZonedTime tz itemTs
|
||||
editable = case itemContent of
|
||||
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs createdAt updatedAt =
|
||||
let editable = case itemContent of
|
||||
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
|
||||
_ -> False
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, localItemTs, createdAt, updatedAt}
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, createdAt, updatedAt}
|
||||
|
||||
instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
|
|
|
|||
|
|
@ -320,7 +320,6 @@ import qualified Data.Text as T
|
|||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time (addUTCTime)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
|
||||
import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
|
||||
import Data.Type.Equality
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..))
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
|
|
@ -3787,9 +3786,8 @@ getChatPreviews db user withPCC = do
|
|||
|
||||
getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat]
|
||||
getDirectChatPreviews_ db user@User {userId} = do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
map (toDirectChatPreview tz currentTs)
|
||||
map (toDirectChatPreview currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -3843,18 +3841,17 @@ getDirectChatPreviews_ db user@User {userId} = do
|
|||
|]
|
||||
(CISRcvNew, userId, ConnReady, ConnSndReady)
|
||||
where
|
||||
toDirectChatPreview :: TimeZone -> UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
|
||||
toDirectChatPreview tz currentTs (contactRow :. connRow :. statsRow :. ciRow_) =
|
||||
toDirectChatPreview :: UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
|
||||
toDirectChatPreview currentTs (contactRow :. connRow :. statsRow :. ciRow_) =
|
||||
let contact = toContact user $ contactRow :. connRow
|
||||
ci_ = toDirectChatItemList tz currentTs ciRow_
|
||||
ci_ = toDirectChatItemList currentTs ciRow_
|
||||
stats = toChatStats statsRow
|
||||
in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats
|
||||
|
||||
getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChat]
|
||||
getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
map (toGroupChatPreview tz currentTs)
|
||||
map (toGroupChatPreview currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -3915,10 +3912,10 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
|||
|]
|
||||
(CISRcvNew, userId, userContactId)
|
||||
where
|
||||
toGroupChatPreview :: TimeZone -> UTCTime -> GroupInfoRow :. ChatStatsRow :. MaybeGroupChatItemRow -> AChat
|
||||
toGroupChatPreview tz currentTs (groupInfoRow :. statsRow :. ciRow_) =
|
||||
toGroupChatPreview :: UTCTime -> GroupInfoRow :. ChatStatsRow :. MaybeGroupChatItemRow -> AChat
|
||||
toGroupChatPreview currentTs (groupInfoRow :. statsRow :. ciRow_) =
|
||||
let groupInfo = toGroupInfo userContactId groupInfoRow
|
||||
ci_ = toGroupChatItemList tz currentTs userContactId ciRow_
|
||||
ci_ = toGroupChatItemList currentTs userContactId ciRow_
|
||||
stats = toChatStats statsRow
|
||||
in AChat SCTGroup $ Chat (GroupChat groupInfo) ci_ stats
|
||||
|
||||
|
|
@ -4026,9 +4023,8 @@ getDirectChatLast_ db user ct@Contact {contactId} count search = do
|
|||
-- the last items in reverse order (the last item in the conversation is the first in the returned list)
|
||||
getDirectChatItemsLast :: DB.Connection -> User -> ContactId -> Int -> String -> ExceptT StoreError IO [CChatItem 'CTDirect]
|
||||
getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
mapM (toDirectChatItem tz currentTs)
|
||||
mapM (toDirectChatItem currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -4056,9 +4052,8 @@ getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId coun
|
|||
where
|
||||
getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect])
|
||||
getDirectChatItemsAfter_ = do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
mapM (toDirectChatItem tz currentTs)
|
||||
mapM (toDirectChatItem currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -4087,9 +4082,8 @@ getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId co
|
|||
where
|
||||
getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect])
|
||||
getDirectChatItemsBefore_ = do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
mapM (toDirectChatItem tz currentTs)
|
||||
mapM (toDirectChatItem currentTs)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -4523,9 +4517,8 @@ getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId =
|
|||
|
||||
getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
join <$> firstRow (toDirectChatItem tz currentTs) (SEChatItemNotFound itemId) getItem
|
||||
join <$> firstRow (toDirectChatItem currentTs) (SEChatItemNotFound itemId) getItem
|
||||
where
|
||||
getItem =
|
||||
DB.query
|
||||
|
|
@ -4684,9 +4677,8 @@ getGroupMemberCIBySharedMsgId db user@User {userId} groupId memberId sharedMsgId
|
|||
|
||||
getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
tz <- getCurrentTimeZone
|
||||
currentTs <- getCurrentTime
|
||||
join <$> firstRow (toGroupChatItem tz currentTs userContactId) (SEChatItemNotFound itemId) getItem
|
||||
join <$> firstRow (toGroupChatItem currentTs userContactId) (SEChatItemNotFound itemId) getItem
|
||||
where
|
||||
getItem =
|
||||
DB.query
|
||||
|
|
@ -5135,8 +5127,8 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
|||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
|
|
@ -5163,14 +5155,14 @@ toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemConte
|
|||
ciMeta content status =
|
||||
let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect deletedTs) else Nothing
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive tz currentTs itemTs createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
|
||||
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ _ = []
|
||||
toDirectChatItemList :: UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
|
||||
toDirectChatItemList currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
|
|
@ -5185,8 +5177,8 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
|||
direction _ _ = Nothing
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
|
|
@ -5219,14 +5211,14 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgD
|
|||
then Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
else Nothing
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive tz currentTs itemTs createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList _ _ _ _ = []
|
||||
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList _ _ _ = []
|
||||
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
|
||||
getProtocolServers db User {userId} =
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ import qualified Data.Text as T
|
|||
import Data.Text.Encoding (decodeLatin1)
|
||||
import Data.Time.Clock (DiffTime, UTCTime)
|
||||
import Data.Time.Format (defaultTimeLocale, formatTime)
|
||||
import Data.Time.LocalTime (TimeZone, ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime, utcToZonedTime)
|
||||
import Data.Time.LocalTime (TimeZone, localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime)
|
||||
import Data.Word (Word32)
|
||||
import GHC.Generics (Generic)
|
||||
import qualified Network.HTTP.Types as Q
|
||||
|
|
@ -70,7 +70,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
|
|||
CRChatStopped -> ["chat stopped"]
|
||||
CRChatSuspended -> ["chat suspended"]
|
||||
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats]
|
||||
CRChats chats -> viewChats ts chats
|
||||
CRChats chats -> viewChats ts tz chats
|
||||
CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat]
|
||||
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
|
||||
CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
|
||||
|
|
@ -84,17 +84,17 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
|
|||
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
|
||||
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
|
||||
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts <> viewItemReactions item
|
||||
CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts <> viewItemReactions item) chatItems
|
||||
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts tz <> viewItemReactions item
|
||||
CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
|
||||
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
|
||||
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated u _ -> ttyUser u []
|
||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz
|
||||
CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
|
||||
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts testView
|
||||
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
|
||||
CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz
|
||||
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts t
|
||||
CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts tz t
|
||||
CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
|
||||
CRCmdAccepted _ -> []
|
||||
CRCmdOk u_ -> ttyUser' u_ ["ok"]
|
||||
|
|
@ -352,11 +352,11 @@ showSMPServer = B.unpack . strEncode . host
|
|||
viewHostEvent :: AProtocolType -> TransportHost -> String
|
||||
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
|
||||
|
||||
viewChats :: CurrentTime -> [AChat] -> [StyledString]
|
||||
viewChats ts = concatMap chatPreview . reverse
|
||||
viewChats :: CurrentTime -> TimeZone -> [AChat] -> [StyledString]
|
||||
viewChats ts tz = concatMap chatPreview . reverse
|
||||
where
|
||||
chatPreview (AChat _ (Chat chat items _)) = case items of
|
||||
CChatItem _ ci : _ -> case viewChatItem chat ci True ts of
|
||||
CChatItem _ ci : _ -> case viewChatItem chat ci True ts tz of
|
||||
s : _ -> [let s' = sTake 120 s in if sLength s' < sLength s then s' <> "..." else s']
|
||||
_ -> chatName
|
||||
_ -> chatName
|
||||
|
|
@ -366,8 +366,8 @@ viewChats ts = concatMap chatPreview . reverse
|
|||
GroupChat g -> [" " <> ttyToGroup g]
|
||||
_ -> []
|
||||
|
||||
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString]
|
||||
viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts =
|
||||
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
||||
viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz =
|
||||
withItemDeleted <$> case chat of
|
||||
DirectChat c -> case chatDir of
|
||||
CIDirectSnd -> case content of
|
||||
|
|
@ -378,8 +378,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
|
|||
to = ttyToContact' c
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts meta
|
||||
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts meta
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
|
||||
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
|
||||
CIRcvGroupEvent {} -> showRcvItemProhibited from
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
|
|
@ -395,8 +395,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
|
|||
to = ttyToGroup g
|
||||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts meta
|
||||
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts meta
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
|
||||
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
|
||||
CIRcvGroupInvitation {} -> showRcvItemProhibited from
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
|
|
@ -410,17 +410,17 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
|
|||
Just t -> item <> styled (colored Red) (" [" <> t <> "]")
|
||||
withSndFile = withFile viewSentFileInvitation
|
||||
withRcvFile = withFile viewReceivedFileInvitation
|
||||
withFile view dir l = maybe l (\f -> l <> view dir f ts meta) file
|
||||
withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file
|
||||
sndMsg = msg viewSentMessage
|
||||
rcvMsg = msg viewReceivedMessage
|
||||
msg view dir quote mc = case (msgContentText mc, file, quote) of
|
||||
("", Just _, []) -> []
|
||||
("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts meta
|
||||
_ -> view dir quote mc ts meta
|
||||
showSndItem to = showItem $ sentWithTime_ ts [to <> plainContent content] meta
|
||||
showRcvItem from = showItem $ receivedWithTime_ ts from [] meta [plainContent content] False
|
||||
showSndItemProhibited to = showItem $ sentWithTime_ ts [to <> plainContent content <> " " <> prohibited] meta
|
||||
showRcvItemProhibited from = showItem $ receivedWithTime_ ts from [] meta [plainContent content <> " " <> prohibited] False
|
||||
("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts tz meta
|
||||
_ -> view dir quote mc ts tz meta
|
||||
showSndItem to = showItem $ sentWithTime_ ts tz [to <> plainContent content] meta
|
||||
showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content] False
|
||||
showSndItemProhibited to = showItem $ sentWithTime_ ts tz [to <> plainContent content <> " " <> prohibited] meta
|
||||
showRcvItemProhibited from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content <> " " <> prohibited] False
|
||||
showItem ss = if doShow then ss else []
|
||||
plainContent = plain . ciContentToText
|
||||
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
|
||||
|
|
@ -451,18 +451,18 @@ localTs tz ts = do
|
|||
formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime
|
||||
formattedTime
|
||||
|
||||
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString]
|
||||
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts = case chat of
|
||||
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
||||
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
|
||||
DirectChat c -> case chatDir of
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc
|
||||
| itemLive == Just True && not liveItems -> []
|
||||
| otherwise -> viewReceivedUpdatedMessage from quote mc ts meta
|
||||
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
from = if itemEdited then ttyFromContactEdited c else ttyFromContact c
|
||||
CIDirectSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts meta
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
to = if itemEdited then ttyToContactEdited' c else ttyToContact' c
|
||||
|
|
@ -472,12 +472,12 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}
|
|||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc
|
||||
| itemLive == Just True && not liveItems -> []
|
||||
| otherwise -> viewReceivedUpdatedMessage from quote mc ts meta
|
||||
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
|
||||
CIGroupSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts meta
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
|
||||
|
|
@ -494,18 +494,18 @@ viewItemNotChanged (AChatItem _ msgDir _ _) = case msgDir of
|
|||
SMDSnd -> ["message didn't change"]
|
||||
SMDRcv -> []
|
||||
|
||||
viewItemDelete :: ChatInfo c -> ChatItem c d -> Maybe AChatItem -> Bool -> Bool -> CurrentTime -> Bool -> [StyledString]
|
||||
viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem byUser timed ts testView
|
||||
viewItemDelete :: ChatInfo c -> ChatItem c d -> Maybe AChatItem -> Bool -> Bool -> CurrentTime -> TimeZone -> Bool -> [StyledString]
|
||||
viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem byUser timed ts tz testView
|
||||
| timed = [plain ("timed message deleted: " <> T.unpack (ciContentToText deletedContent)) | testView]
|
||||
| byUser = [plain $ "message " <> T.unpack (fromMaybe "deleted" deletedText_)] -- deletedText_ Nothing should be impossible here
|
||||
| otherwise = case chat of
|
||||
DirectChat c -> case (chatDir, deletedContent) of
|
||||
(CIDirectRcv, CIRcvMsgContent mc) -> viewReceivedMessage (ttyFromContactDeleted c deletedText_) [] mc ts meta
|
||||
(CIDirectRcv, CIRcvMsgContent mc) -> viewReceivedMessage (ttyFromContactDeleted c deletedText_) [] mc ts tz meta
|
||||
_ -> prohibited
|
||||
GroupChat g -> case ciMsgContent deletedContent of
|
||||
Just mc ->
|
||||
let m = chatItemMember g ci
|
||||
in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts meta
|
||||
in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts tz meta
|
||||
_ -> prohibited
|
||||
_ -> prohibited
|
||||
where
|
||||
|
|
@ -534,7 +534,7 @@ viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md
|
|||
(_, CIGroupSnd) -> [sentText]
|
||||
where
|
||||
view from msg
|
||||
| showReactions = viewReceivedReaction from msg reactionText ts $ utcToZonedTime tz sentAt
|
||||
| showReactions = viewReceivedReaction from msg reactionText ts tz sentAt
|
||||
| otherwise = []
|
||||
reactionText = plain $ (if added then "+ " else "- ") <> [emoji]
|
||||
emoji = case reaction of
|
||||
|
|
@ -577,11 +577,11 @@ msgPreview = msgPlain . preview . msgContentText
|
|||
| T.length t <= 120 = t
|
||||
| otherwise = T.take 120 t <> "..."
|
||||
|
||||
viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> CIMeta c 'MDRcv -> [StyledString]
|
||||
viewRcvIntegrityError from msgErr ts meta = receivedWithTime_ ts from [] meta (viewMsgIntegrityError msgErr) False
|
||||
viewRcvIntegrityError :: StyledString -> MsgErrorType -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [StyledString]
|
||||
viewRcvIntegrityError from msgErr ts tz meta = receivedWithTime_ ts tz from [] meta (viewMsgIntegrityError msgErr) False
|
||||
|
||||
viewRcvDecryptionError :: StyledString -> MsgDecryptError -> Word32 -> CurrentTime -> CIMeta c 'MDRcv -> [StyledString]
|
||||
viewRcvDecryptionError from err n ts meta = receivedWithTime_ ts from [] meta [ttyError $ msgDecryptErrorText err n] False
|
||||
viewRcvDecryptionError :: StyledString -> MsgDecryptError -> Word32 -> CurrentTime -> TimeZone -> CIMeta c 'MDRcv -> [StyledString]
|
||||
viewRcvDecryptionError from err n ts tz meta = receivedWithTime_ ts tz from [] meta [ttyError $ msgDecryptErrorText err n] False
|
||||
|
||||
viewMsgIntegrityError :: MsgErrorType -> [StyledString]
|
||||
viewMsgIntegrityError err = [ttyError $ msgIntegrityError err]
|
||||
|
|
@ -1079,22 +1079,22 @@ viewContactUpdated
|
|||
where
|
||||
fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
|
||||
|
||||
viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString]
|
||||
viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewReceivedMessage = viewReceivedMessage_ False
|
||||
|
||||
viewReceivedUpdatedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString]
|
||||
viewReceivedUpdatedMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewReceivedUpdatedMessage = viewReceivedMessage_ True
|
||||
|
||||
viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString]
|
||||
viewReceivedMessage_ updated from quote mc ts meta = receivedWithTime_ ts from quote meta (ttyMsgContent mc) updated
|
||||
viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewReceivedMessage_ updated from quote mc ts tz meta = receivedWithTime_ ts tz from quote meta (ttyMsgContent mc) updated
|
||||
|
||||
viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> ZonedTime -> [StyledString]
|
||||
viewReceivedReaction from styledMsg reactionText ts reactionTs =
|
||||
prependFirst (ttyMsgTime ts reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText])
|
||||
viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
|
||||
viewReceivedReaction from styledMsg reactionText ts tz reactionTs =
|
||||
prependFirst (ttyMsgTime ts tz reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText])
|
||||
|
||||
receivedWithTime_ :: CurrentTime -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString]
|
||||
receivedWithTime_ ts from quote CIMeta {localItemTs, itemId, itemEdited, itemDeleted, itemLive} styledMsg updated = do
|
||||
prependFirst (ttyMsgTime ts localItemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg)
|
||||
receivedWithTime_ :: CurrentTime -> TimeZone -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString]
|
||||
receivedWithTime_ ts tz from quote CIMeta {itemId, itemTs, itemEdited, itemDeleted, itemLive} styledMsg updated = do
|
||||
prependFirst (ttyMsgTime ts tz itemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg)
|
||||
where
|
||||
indent = if null quote then "" else " "
|
||||
live
|
||||
|
|
@ -1106,19 +1106,19 @@ receivedWithTime_ ts from quote CIMeta {localItemTs, itemId, itemEdited, itemDel
|
|||
Just False -> ttyFrom "[LIVE ended] "
|
||||
_ -> ""
|
||||
|
||||
ttyMsgTime :: CurrentTime -> ZonedTime -> StyledString
|
||||
ttyMsgTime ts t =
|
||||
let localTime = zonedTimeToLocalTime t
|
||||
tz = zonedTimeZone t
|
||||
ttyMsgTime :: CurrentTime -> TimeZone -> UTCTime -> StyledString
|
||||
ttyMsgTime currentTime tz time =
|
||||
let localTime = utcToLocalTime tz time
|
||||
localCurrentTime = utcToLocalTime tz currentTime
|
||||
fmt =
|
||||
if (localDay localTime < localDay (zonedTimeToLocalTime $ utcToZonedTime tz ts))
|
||||
if (localDay localTime < localDay localCurrentTime)
|
||||
&& (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 fmt localTime
|
||||
|
||||
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString]
|
||||
viewSentMessage to quote mc ts meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts (prependFirst to $ quote <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
|
||||
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewSentMessage to quote mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts tz (prependFirst to $ quote <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
|
||||
where
|
||||
indent = if null quote then "" else " "
|
||||
live
|
||||
|
|
@ -1128,12 +1128,12 @@ viewSentMessage to quote mc ts meta@CIMeta {itemEdited, itemDeleted, itemLive} =
|
|||
Just False -> ttyTo "[LIVE] "
|
||||
_ -> ""
|
||||
|
||||
viewSentBroadcast :: MsgContent -> Int -> CurrentTime -> ZonedTime -> [StyledString]
|
||||
viewSentBroadcast mc n ts t = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts t <> " ") (ttyMsgContent mc)
|
||||
viewSentBroadcast :: MsgContent -> Int -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
|
||||
viewSentBroadcast mc n ts tz time = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts tz time <> " ") (ttyMsgContent mc)
|
||||
|
||||
viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> CIMeta c d -> [StyledString]
|
||||
viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePath of
|
||||
Just fPath -> sentWithTime_ ts $ ttySentFile fPath
|
||||
viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts tz = case filePath of
|
||||
Just fPath -> sentWithTime_ ts tz $ ttySentFile fPath
|
||||
_ -> const []
|
||||
where
|
||||
ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending
|
||||
|
|
@ -1141,9 +1141,9 @@ viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePa
|
|||
CIFSSndTransfer _ _ -> []
|
||||
_ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
|
||||
|
||||
sentWithTime_ :: CurrentTime -> [StyledString] -> CIMeta c d -> [StyledString]
|
||||
sentWithTime_ ts styledMsg CIMeta {localItemTs} =
|
||||
prependFirst (ttyMsgTime ts localItemTs <> " ") styledMsg
|
||||
sentWithTime_ :: CurrentTime -> TimeZone -> [StyledString] -> CIMeta c d -> [StyledString]
|
||||
sentWithTime_ ts tz styledMsg CIMeta {itemTs} =
|
||||
prependFirst (ttyMsgTime ts tz itemTs <> " ") styledMsg
|
||||
|
||||
ttyMsgContent :: MsgContent -> [StyledString]
|
||||
ttyMsgContent = msgPlain . msgContentText
|
||||
|
|
@ -1179,8 +1179,8 @@ uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
|
|||
sndFile :: SndFileTransfer -> StyledString
|
||||
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
|
||||
|
||||
viewReceivedFileInvitation :: StyledString -> CIFile d -> CurrentTime -> CIMeta c d -> [StyledString]
|
||||
viewReceivedFileInvitation from file ts meta = receivedWithTime_ ts from [] meta (receivedFileInvitation_ file) False
|
||||
viewReceivedFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewReceivedFileInvitation from file ts tz meta = receivedWithTime_ ts tz from [] meta (receivedFileInvitation_ file) False
|
||||
|
||||
receivedFileInvitation_ :: CIFile d -> [StyledString]
|
||||
receivedFileInvitation_ CIFile {fileId, fileName, fileSize, fileStatus} =
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue