docker: statically build CLI

Dockerfile

@@ -1,11 +1,20 @@
-ARG TAG=22.04
+FROM alpine:latest AS build-stage
 
-FROM ubuntu:${TAG} AS build
-
-### Build stage
-
-# Install curl and git and simplex-chat dependencies
-RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev libssl-dev
+# Alpine Linux doesn't provide libtinfow.so.6 library, so we need to symlink it.
+# Add essential packages for ghc/cabal to work.
+RUN apk add --no-cache \
+    curl \
+    git \
+    xz \
+    grep \
+    ghc-dev \
+    gmp-dev \
+    zlib-static \
+    zlib-dev \
+    openssl-libs-static \
+    openssl-dev \
+    alpine-sdk &&\
+    ln -s /usr/lib/libncursesw.so.6 /usr/lib/libtinfow.so.6
 
 # Specify bootstrap Haskell versions
 ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
@@ -21,21 +30,30 @@ ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
 RUN ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" && \
     ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
 
+# Install hpack
+RUN cabal install --install-method=copy --installdir=/usr/local/bin hpack-0.36.0
+
+# Copy project in PWD to dontainer
 COPY . /project
 WORKDIR /project
 
 # Adjust build
 RUN cp ./scripts/cabal.project.local.linux ./cabal.project.local
 
+# Add optimization flags and build statically  
+RUN sed -i '/- -Wunused-type-patterns/a\  - -O2\n\  - -split-sections\n\  - -with-rtsopts=-N\n\  - -static\n\cc-options: -static\n\ld-options: -static -pthread' package.yaml
+
+# Reconfigure cabal project
+RUN hpack
+
 # Compile simplex-chat
 RUN cabal update
-RUN cabal build exe:simplex-chat
+RUN cabal build -j exe:simplex-chat
 
 # Strip the binary from debug symbols to reduce size
 RUN bin=$(find /project/dist-newstyle -name "simplex-chat" -type f -executable) && \
     mv "$bin" ./ && \
     strip ./simplex-chat
 
-# Copy compiled app from build stage
 FROM scratch AS export-stage
-COPY --from=build /project/simplex-chat /
+COPY --from=build-stage /project/simplex-chat /

src/Simplex/Chat.hs

@@ -1665,9 +1665,7 @@ processChatCommand' vr = \case
   APIMemberRole groupId memberId memRole -> withUser $ \user -> do
     Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user groupId
     if memberId == groupMemberId' membership
-      then do
-        when (memRole < GRAdmin) $ deleteGroupLinkIfExists user gInfo
-        changeMemberRole user gInfo members membership $ SGEUserRole memRole
+      then changeMemberRole user gInfo members membership $ SGEUserRole memRole
       else case find ((== memberId) . groupMemberId') members of
         Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole
         _ -> throwChatError CEGroupMemberNotFound
@@ -5492,28 +5490,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> m ()
     xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs
       | membershipMemId == memId =
-          checkRole membership $ do
-            when (memRole < GRAdmin) $ deleteGroupLinkIfExists user gInfo
-            let gInfo' = gInfo {membership = membership {memberRole = memRole}}
-            changeMemberRole gInfo' membership $ RGEUserRole memRole
+          let gInfo' = gInfo {membership = membership {memberRole = memRole}}
+           in changeMemberRole gInfo' membership $ RGEUserRole memRole
       | otherwise =
           withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
-            Right member ->
-              checkRole member $ do
-                let gEvent = RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole
-                changeMemberRole gInfo member gEvent
+            Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole
             Left _ -> messageError "x.grp.mem.role with unknown member ID"
       where
         GroupMember {memberId = membershipMemId} = membership
-        checkRole GroupMember {memberRole = fromRole} a
-          | senderRole < GRAdmin || senderRole < fromRole =
-              messageError "x.grp.mem.role with insufficient member permissions"
-          | otherwise = a
-        changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent = do
-          withStore' $ \db -> updateGroupMemberRole db user member memRole
-          ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
-          groupMsgToView gInfo ci
-          toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
+        changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent
+          | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions"
+          | otherwise = do
+              withStore' $ \db -> updateGroupMemberRole db user member memRole
+              ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
+              groupMsgToView gInfo ci
+              toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
 
     checkHostRole :: GroupMember -> GroupMemberRole -> m ()
     checkHostRole GroupMember {memberRole, localDisplayName} memRole =

tests/Bots/DirectoryTests.hs

@@ -38,7 +38,7 @@ directoryServiceTests = do
     it "should de-list if service is removed from the group" testDelistedServiceRemoved
     it "should de-list/re-list when service/owner roles change" testDelistedRoleChanges
     it "should NOT de-list if another member role changes" testNotDelistedMemberRoleChanged
-    fit "should NOT send to approval if roles are incorrect" testNotSentApprovalBadRoles
+    it "should NOT send to approval if roles are incorrect" testNotSentApprovalBadRoles
     it "should NOT allow approving if roles are incorrect" testNotApprovedBadRoles
   describe "should require re-approval if profile is changed by" $ do
     it "the registration owner" testRegOwnerChangedProfile
@@ -55,7 +55,7 @@ directoryServiceTests = do
   describe "list groups" $ do
     it "should list user's groups" testListUserGroups
   describe "store log" $ do
-    fit "should restore directory service state" testRestoreDirectory
+    it "should restore directory service state" testRestoreDirectory
 
 directoryProfile :: Profile
 directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}

tests/ChatClient.hs

@@ -346,8 +346,8 @@ getTermLine cc =
   5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case
     Just s -> do
       -- remove condition to always echo virtual terminal
-      when True $ do
-      -- when (printOutput cc) $ do
+      -- when True $ do
+      when (printOutput cc) $ do
         name <- userName cc
         putStrLn $ name <> ": " <> s
       pure s

tests/ChatTests/Groups.hs

@@ -78,7 +78,6 @@ chatGroupTests = do
     it "invitee incognito" testGroupLinkNoContactInviteeIncognito
     it "host profile received" testGroupLinkNoContactHostProfileReceived
     it "existing contact merged" testGroupLinkNoContactExistingContactMerged
-    it "group link is deleted if user role lowers below admin" testGroupLinkUserRoleLowers
   describe "group links without contact connection plan" $ do
     it "group link without contact - known group" testPlanGroupLinkNoContactKnown
     it "group link without contact - connecting" testPlanGroupLinkNoContactConnecting
@@ -3115,60 +3114,6 @@ testGroupLinkNoContactExistingContactMerged =
       bob #> "#team hi there"
       alice <# "#team bob> hi there"
 
-testGroupLinkUserRoleLowers :: HasCallStack => FilePath -> IO ()
-testGroupLinkUserRoleLowers =
-  testChat3 aliceProfile bobProfile cathProfile $
-    \alice bob cath -> do
-      alice ##> "/g team"
-      alice <## "group #team is created"
-      alice <## "to add members use /a team <name> or /create link #team"
-
-      alice ##> "/set history #team off"
-      alice <## "updated group preferences:"
-      alice <## "Recent history: off"
-
-      alice ##> "/create link #team"
-      gLink <- getGroupLink alice "team" GRMember True
-
-      -- lowering role from owner to admin - link works
-      alice ##> "/mr #team alice admin"
-      alice <## "#team: you changed your role from owner to admin"
-
-      bob ##> ("/c " <> gLink)
-      bob <## "connection request sent!"
-      alice <## "bob (Bob): accepting request to join group #team..."
-      concurrentlyN_
-        [ alice <## "#team: bob joined the group",
-          do
-            bob <## "#team: joining the group..."
-            bob <## "#team: you joined the group"
-        ]
-
-      alice #> "#team hello"
-      bob <# "#team alice> hello"
-      bob #> "#team hi there"
-      alice <# "#team bob> hi there"
-
-      alice ##> "/mr #team bob admin"
-      alice <## "#team: you changed the role of bob from member to admin"
-      bob <## "#team: alice changed your role from member to admin"
-
-      -- lowering role below admin - link is deleted
-      bob ##> "/mr #team alice member"
-      bob <## "#team: you changed the role of alice from admin to member"
-      alice <## "#team: bob changed your role from admin to member"
-
-      cath ##> ("/c " <> gLink)
-      cath <## "error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection"
-      cath ##> "/gs"
-      cath <## "you have no groups!"
-      cath <## "to create: /g <name>"
-
-      alice #> "#team hello"
-      bob <# "#team alice> hello"
-      bob #> "#team hi there"
-      alice <# "#team bob> hi there"
-
 testPlanGroupLinkNoContactKnown :: HasCallStack => FilePath -> IO ()
 testPlanGroupLinkNoContactKnown =
   testChat2 aliceProfile bobProfile $