dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-13 21:33:41 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: use GHC 9.6.2 (#2641)

Browse Source 
* Make it compiler with 9.6

Can be built with:

cabal build all -j --allow-newer=base --allow-newer=ghc-prim --allow-newer=template-haskell --allow-newer=bytestring --allow-newer=memory --allow-newer=cryptonite

Using ghc 9.6

It mostly runs afoul of https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0366-no-ambiguous-field-access.rst

* compile with GHC 9.6.2: dependencies, imports, code

* update GHC version in CI

* update GHC version in desktop build scripts

* update simplexmq, sha256map.nix

* update compiler

* update simplexmq, direct-sqlcipher

* remove missing files from .cabal

* building on desktop

* mac build changes

* added version back

* building libffi from source

* update simplexmq

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Co-authored-by: Avently <7953703+avently@users.noreply.github.com>
This commit is contained in:
Moritz Angermann
2023-08-25 04:56:37 +08:00
committed by GitHub
parent 06369e277c
commit 761ddac55d
36 changed files with 285 additions and 190 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Connections.hs
+2
View File
@@ -4,6 +4,8 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Connections
( getConnectionEntity,
)
src/Simplex/Chat/Store/Direct.hs
+6 -1
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -7,6 +8,8 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Direct
( updateContact_,
updateContactProfile_,
@@ -60,7 +63,9 @@ module Simplex.Chat.Store.Direct
)
where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Either (rights)
import Data.Functor (($>))
import Data.Int (Int64)
@@ -424,7 +429,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi
ExceptT $
maybeM getContactRequestByXContactId xContactId_ >>= \case
Nothing -> createContactRequest
Just cr -> updateContactRequest cr $> Right (contactRequestId (cr :: UserContactRequest))
Just cr -> updateContactRequest cr $> Right cr.contactRequestId
getContactRequest db user cReqId
createContactRequest :: IO (Either StoreError Int64)
createContactRequest = do
src/Simplex/Chat/Store/Files.hs
+8 -2
View File
@@ -74,7 +74,9 @@ module Simplex.Chat.Store.Files
where
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Either (rights)
import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
@@ -478,7 +480,9 @@ createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation ->
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
currentTs <- liftIO getCurrentTime
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
let getFDId :: RcvFileDescr -> Int64
getFDId RcvFileDescr{fileDescrId} = fileDescrId
let rfdId = getFDId <$> rfd_
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
fileId <- liftIO $ do
@@ -498,7 +502,9 @@ createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvi
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
currentTs <- liftIO getCurrentTime
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
let getFDId :: RcvFileDescr -> Int64
getFDId RcvFileDescr{fileDescrId} = fileDescrId
let rfdId = getFDId <$> rfd_
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
fileId <- liftIO $ do
src/Simplex/Chat/Store/Groups.hs
+12 -3
View File
@@ -8,6 +8,9 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Groups
( -- * Util methods
@@ -86,7 +89,9 @@ module Simplex.Chat.Store.Groups
)
where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Either (rights)
import Data.Int (Int64)
@@ -862,7 +867,7 @@ saveIntroInvitation db reMember toMember introInv = do
WHERE group_member_intro_id = :intro_id
|]
[ ":intro_status" := GMIntroInvReceived,
":group_queue_info" := groupConnReq (introInv :: IntroInvitation),
":group_queue_info" := introInv.groupConnReq,
":direct_queue_info" := directConnReq introInv,
":updated_at" := currentTs,
":intro_id" := introId intro
@@ -909,7 +914,9 @@ getIntroduction_ db reMember toMember = ExceptT $ do
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> (CommandId, ConnId) -> Maybe ProfileId -> ExceptT StoreError IO GroupMember
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) (groupCmdId, groupAgentConnId) (directCmdId, directAgentConnId) customUserProfileId = do
let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
let cLevel = 1 + case activeConn of
Just (Connection{connLevel}) -> connLevel
_ -> 0
currentTs <- liftIO getCurrentTime
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId memberContactId Nothing customUserProfileId cLevel currentTs
liftIO $ setCommandConnId db user directCmdId directConnId
@@ -932,7 +939,9 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> (CommandId, ConnId) -> (CommandId, ConnId) -> Maybe ProfileId -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} (groupCmdId, groupAgentConnId) (directCmdId, directAgentConnId) customUserProfileId = do
let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
let cLevel = 1 + case activeConn of
Just (Connection{connLevel}) -> connLevel
_ -> 0
currentTs <- getCurrentTime
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId viaContactId cLevel currentTs
setCommandConnId db user groupCmdId groupConnId
src/Simplex/Chat/Store/Messages.hs
+4
View File
@@ -10,6 +10,8 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Messages
( getContactConnIds_,
getDirectChatReactions_,
@@ -97,7 +99,9 @@ module Simplex.Chat.Store.Messages
)
where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
src/Simplex/Chat/Store/Profiles.hs
+5 -1
View File
@@ -7,6 +7,8 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Profiles
( AutoAccept (..),
UserMsgReceiptSettings (..),
@@ -54,7 +56,9 @@ module Simplex.Chat.Store.Profiles
)
where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Aeson (ToJSON)
import qualified Data.Aeson as J
import Data.Functor (($>))
@@ -290,7 +294,7 @@ getUserContactProfiles db User {userId} =
|]
(Only userId)
where
toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> (Profile)
toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> Profile
toContactProfile (displayName, fullName, image, contactLink, preferences) = Profile {displayName, fullName, image, contactLink, preferences}
createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
src/Simplex/Chat/Store/Shared.hs
+2 -1
View File
@@ -10,10 +10,11 @@
module Simplex.Chat.Store.Shared where
import Control.Concurrent.STM (stateTVar)
import Control.Exception (Exception)
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG, randomBytesGenerate)
import Data.Aeson (ToJSON)
import qualified Data.Aeson as J