android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 20:29:53 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

export C interface, started mobile app (#210)

Browse source 
* initial mobile app design draft

* add proposals

* xcode project

* refactor function to send to view as parameter

* export C interface

* remove unused files

* run chat from chatInit

* split chatStart to a separate function

* replace file-embed with QQ

* add mobile views

* server using IP address

* pass dbFilePrefix as parameter to chatInit

* comment on enabling logging

* fix mobile db config

* update C API, make user non-optional in ChatController

* restore SMP server addresses

* revert the change in the tests

* flip dependency - now Controller depends on Terminal

* make ChatController independent of terminal package

* fix Main.hs

* add iOS .gitignore

* refactor Simplex.Chat.Terminal

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin 2022-01-21 11:09:33 +00:00 • committed by GitHub
parent f47494e5c8
commit 64381be91d
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
36 changed files with 2211 additions and 777 deletions
Download patch file Download diff file Expand all files Collapse all files

65
apps/ios/.gitignore vendored Normal file
View file

@ -0,0 +1,65 @@
## User settings
xcuserdata/
## Obj-C/Swift specific
*.hmap
## App packaging
*.ipa
*.dSYM.zip
*.dSYM
# Swift Package Manager
#
# Add this line if you want to avoid checking in source code from Swift Package Manager dependencies.
# Packages/
# Package.pins
# Package.resolved
# *.xcodeproj
#
# Xcode automatically generates this directory with a .xcworkspacedata file and xcuserdata
# hence it is not needed unless you have added a package configuration file to your project
# .swiftpm
.build/
# CocoaPods
#
# We recommend against adding the Pods directory to your .gitignore. However
# you should judge for yourself, the pros and cons are mentioned at:
# https://guides.cocoapods.org/using/using-cocoapods.html#should-i-check-the-pods-directory-into-source-control
#
# Pods/
#
# Add this line if you want to avoid checking in source code from the Xcode workspace
# *.xcworkspace
# Carthage
#
# Add this line if you want to avoid checking in source code from Carthage dependencies.
# Carthage/Checkouts
Carthage/Build/
# Accio dependency management
Dependencies/
.accio/
# fastlane
#
# It is recommended to not store the screenshots in the git repo.
# Instead, use fastlane to re-generate the screenshots whenever they are needed.
# For more information about the recommended setup visit:
# https://docs.fastlane.tools/best-practices/source-control/#source-control
fastlane/report.xml
fastlane/Preview.html
fastlane/screenshots/**/*.png
fastlane/test_output
# Code Injection
#
# After new code Injection tools there's a generated folder /iOSInjectionProject
# https://github.com/johnno1962/injectionforxcode
iOSInjectionProject/

11
apps/ios/Shared/Assets.xcassets/AccentColor.colorset/Contents.json Normal file
View file

@ -0,0 +1,11 @@
{
"colors" : [
{
"idiom" : "universal"
}
],
"info" : {
"author" : "xcode",
"version" : 1
}
}

148
apps/ios/Shared/Assets.xcassets/AppIcon.appiconset/Contents.json Normal file
View file

@ -0,0 +1,148 @@
{
"images" : [
{
"idiom" : "iphone",
"scale" : "2x",
"size" : "20x20"
},
{
"idiom" : "iphone",
"scale" : "3x",
"size" : "20x20"
},
{
"idiom" : "iphone",
"scale" : "2x",
"size" : "29x29"
},
{
"idiom" : "iphone",
"scale" : "3x",
"size" : "29x29"
},
{
"idiom" : "iphone",
"scale" : "2x",
"size" : "40x40"
},
{
"idiom" : "iphone",
"scale" : "3x",
"size" : "40x40"
},
{
"idiom" : "iphone",
"scale" : "2x",
"size" : "60x60"
},
{
"idiom" : "iphone",
"scale" : "3x",
"size" : "60x60"
},
{
"idiom" : "ipad",
"scale" : "1x",
"size" : "20x20"
},
{
"idiom" : "ipad",
"scale" : "2x",
"size" : "20x20"
},
{
"idiom" : "ipad",
"scale" : "1x",
"size" : "29x29"
},
{
"idiom" : "ipad",
"scale" : "2x",
"size" : "29x29"
},
{
"idiom" : "ipad",
"scale" : "1x",
"size" : "40x40"
},
{
"idiom" : "ipad",
"scale" : "2x",
"size" : "40x40"
},
{
"idiom" : "ipad",
"scale" : "1x",
"size" : "76x76"
},
{
"idiom" : "ipad",
"scale" : "2x",
"size" : "76x76"
},
{
"idiom" : "ipad",
"scale" : "2x",
"size" : "83.5x83.5"
},
{
"idiom" : "ios-marketing",
"scale" : "1x",
"size" : "1024x1024"
},
{
"idiom" : "mac",
"scale" : "1x",
"size" : "16x16"
},
{
"idiom" : "mac",
"scale" : "2x",
"size" : "16x16"
},
{
"idiom" : "mac",
"scale" : "1x",
"size" : "32x32"
},
{
"idiom" : "mac",
"scale" : "2x",
"size" : "32x32"
},
{
"idiom" : "mac",
"scale" : "1x",
"size" : "128x128"
},
{
"idiom" : "mac",
"scale" : "2x",
"size" : "128x128"
},
{
"idiom" : "mac",
"scale" : "1x",
"size" : "256x256"
},
{
"idiom" : "mac",
"scale" : "2x",
"size" : "256x256"
},
{
"idiom" : "mac",
"scale" : "1x",
"size" : "512x512"
},
{
"idiom" : "mac",
"scale" : "2x",
"size" : "512x512"
}
],
"info" : {
"author" : "xcode",
"version" : 1
}
}

6
apps/ios/Shared/Assets.xcassets/Contents.json Normal file
View file

@ -0,0 +1,6 @@
{
"info" : {
"author" : "xcode",
"version" : 1
}
}

50
apps/ios/Shared/ContentView.swift Normal file
View file

@ -0,0 +1,50 @@
//
// ContentView.swift
// Shared
//
// Created by Evgeny Poberezkin on 17/01/2022.
//
import SwiftUI
struct ContentView: View {
@State var messages: [String] = ["Start session:"]
@State var text: String = ""
func sendMessage() {
}
var body: some View {
VStack {
ScrollView {
LazyVStack {
ForEach(messages, id: \.self) { msg in
MessageView(message: msg, sent: false)
}
}
.padding(10)
}
.frame(minWidth: 0,
maxWidth: .infinity,
minHeight: 0,
maxHeight: .infinity,
alignment: .topLeading)
HStack {
TextField("Message...", text: $text)
.textFieldStyle(RoundedBorderTextFieldStyle())
.frame(minHeight: CGFloat(30))
Button(action: sendMessage) {
Text("Send")
}.disabled(text.isEmpty)
}
.frame(minHeight: CGFloat(30))
.padding()
}
}
}
struct ContentView_Previews: PreviewProvider {
static var previews: some View {
ContentView(text: "Hello!")
}
}

34
apps/ios/Shared/MessageView.swift Normal file
View file

@ -0,0 +1,34 @@
//
// MessageView.swift
// SimpleX
//
// Created by Evgeny Poberezkin on 18/01/2022.
//
import SwiftUI
struct MessageView: View {
var message: String
var sent: Bool
let receivedColor: Color = Color(UIColor(red: 240/255, green: 240/255, blue: 240/255, alpha: 1.0))
var body: some View {
Text(message)
.padding(10)
.foregroundColor(sent ? Color.white : Color.black)
.background(sent ? Color.blue : receivedColor)
.cornerRadius(10)
.frame(minWidth: 100,
maxWidth: .infinity,
minHeight: 0,
maxHeight: .infinity,
alignment: .leading)
}
}
struct MessageView_Previews: PreviewProvider {
static var previews: some View {
MessageView(message: "> Send message: \"Hello world!\"\nSuccessful", sent: false)
}
}

32
apps/ios/Shared/ProfileView.swift Normal file
View file

@ -0,0 +1,32 @@
//
// ProfileView.swift
// SimpleX
//
// Created by Evgeny Poberezkin on 18/01/2022.
//
import SwiftUI
struct ProfileView: View {
@State var displayName: String = ""
@State var fullName: String = ""
var body: some View {
VStack(alignment: .leading) {
Text("Create profile")
.font(.largeTitle)
.padding(.bottom)
Text("Your profile is stored on your device and shared only with your contacts.\nSimpleX servers cannot see your profile.")
.padding(.bottom)
TextField("Display name", text: $displayName)
.padding(.bottom)
TextField("Full name (optional)", text: $fullName)
}
.padding()
}
}
struct ProfileView_Previews: PreviewProvider {
static var previews: some View {
ProfileView()
}
}

17
apps/ios/Shared/SimpleXApp.swift Normal file
View file

@ -0,0 +1,17 @@
//
// SimpleXApp.swift
// Shared
//
// Created by Evgeny Poberezkin on 17/01/2022.
//
import SwiftUI
@main
struct SimpleXApp: App {
var body: some Scene {
WindowGroup {
ContentView()
}
}
}

720
apps/ios/SimpleX.xcodeproj/project.pbxproj Normal file
View file

@ -0,0 +1,720 @@
// !$*UTF8*$!
{
archiveVersion = 1;
classes = {
};
objectVersion = 55;
objects = {
/* Begin PBXBuildFile section */
5CA059DC279559F40002BEB4 /* Tests_iOS.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059DB279559F40002BEB4 /* Tests_iOS.swift */; };
5CA059DE279559F40002BEB4 /* Tests_iOSLaunchTests.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059DD279559F40002BEB4 /* Tests_iOSLaunchTests.swift */; };
5CA059E8279559F40002BEB4 /* Tests_macOS.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059E7279559F40002BEB4 /* Tests_macOS.swift */; };
5CA059EA279559F40002BEB4 /* Tests_macOSLaunchTests.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059E9279559F40002BEB4 /* Tests_macOSLaunchTests.swift */; };
5CA059EB279559F40002BEB4 /* SimpleXApp.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059C3279559F40002BEB4 /* SimpleXApp.swift */; };
5CA059EC279559F40002BEB4 /* SimpleXApp.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059C3279559F40002BEB4 /* SimpleXApp.swift */; };
5CA059ED279559F40002BEB4 /* ContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059C4279559F40002BEB4 /* ContentView.swift */; };
5CA059EE279559F40002BEB4 /* ContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059C4279559F40002BEB4 /* ContentView.swift */; };
5CA059EF279559F40002BEB4 /* Assets.xcassets in Resources */ = {isa = PBXBuildFile; fileRef = 5CA059C5279559F40002BEB4 /* Assets.xcassets */; };
5CA059F0279559F40002BEB4 /* Assets.xcassets in Resources */ = {isa = PBXBuildFile; fileRef = 5CA059C5279559F40002BEB4 /* Assets.xcassets */; };
5CA05A4C27974EB60002BEB4 /* ProfileView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA05A4B27974EB60002BEB4 /* ProfileView.swift */; };
5CA05A4D27974EB60002BEB4 /* ProfileView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA05A4B27974EB60002BEB4 /* ProfileView.swift */; };
5CA05A4F279752D00002BEB4 /* MessageView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA05A4E279752D00002BEB4 /* MessageView.swift */; };
5CA05A50279752D00002BEB4 /* MessageView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA05A4E279752D00002BEB4 /* MessageView.swift */; };
/* End PBXBuildFile section */
/* Begin PBXContainerItemProxy section */
5CA059D8279559F40002BEB4 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 5CA059BE279559F40002BEB4 /* Project object */;
proxyType = 1;
remoteGlobalIDString = 5CA059C9279559F40002BEB4;
remoteInfo = "SimpleX (iOS)";
};
5CA059E4279559F40002BEB4 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 5CA059BE279559F40002BEB4 /* Project object */;
proxyType = 1;
remoteGlobalIDString = 5CA059CF279559F40002BEB4;
remoteInfo = "SimpleX (macOS)";
};
/* End PBXContainerItemProxy section */
/* Begin PBXFileReference section */
5CA059C3279559F40002BEB4 /* SimpleXApp.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SimpleXApp.swift; sourceTree = "<group>"; };
5CA059C4279559F40002BEB4 /* ContentView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ContentView.swift; sourceTree = "<group>"; };
5CA059C5279559F40002BEB4 /* Assets.xcassets */ = {isa = PBXFileReference; lastKnownFileType = folder.assetcatalog; path = Assets.xcassets; sourceTree = "<group>"; };
5CA059CA279559F40002BEB4 /* SimpleX.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = SimpleX.app; sourceTree = BUILT_PRODUCTS_DIR; };
5CA059D0279559F40002BEB4 /* SimpleX.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = SimpleX.app; sourceTree = BUILT_PRODUCTS_DIR; };
5CA059D2279559F40002BEB4 /* macOS.entitlements */ = {isa = PBXFileReference; lastKnownFileType = text.plist.entitlements; path = macOS.entitlements; sourceTree = "<group>"; };
5CA059D7279559F40002BEB4 /* Tests iOS.xctest */ = {isa = PBXFileReference; explicitFileType = wrapper.cfbundle; includeInIndex = 0; path = "Tests iOS.xctest"; sourceTree = BUILT_PRODUCTS_DIR; };
5CA059DB279559F40002BEB4 /* Tests_iOS.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Tests_iOS.swift; sourceTree = "<group>"; };
5CA059DD279559F40002BEB4 /* Tests_iOSLaunchTests.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Tests_iOSLaunchTests.swift; sourceTree = "<group>"; };
5CA059E3279559F40002BEB4 /* Tests macOS.xctest */ = {isa = PBXFileReference; explicitFileType = wrapper.cfbundle; includeInIndex = 0; path = "Tests macOS.xctest"; sourceTree = BUILT_PRODUCTS_DIR; };
5CA059E7279559F40002BEB4 /* Tests_macOS.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Tests_macOS.swift; sourceTree = "<group>"; };
5CA059E9279559F40002BEB4 /* Tests_macOSLaunchTests.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Tests_macOSLaunchTests.swift; sourceTree = "<group>"; };
5CA05A4B27974EB60002BEB4 /* ProfileView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ProfileView.swift; sourceTree = "<group>"; };
5CA05A4E279752D00002BEB4 /* MessageView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MessageView.swift; sourceTree = "<group>"; };
/* End PBXFileReference section */
/* Begin PBXFrameworksBuildPhase section */
5CA059C7279559F40002BEB4 /* Frameworks */ = {
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059CD279559F40002BEB4 /* Frameworks */ = {
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059D4279559F40002BEB4 /* Frameworks */ = {
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059E0279559F40002BEB4 /* Frameworks */ = {
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXFrameworksBuildPhase section */
/* Begin PBXGroup section */
5CA059BD279559F40002BEB4 = {
isa = PBXGroup;
children = (
5CA059C2279559F40002BEB4 /* Shared */,
5CA059D1279559F40002BEB4 /* macOS */,
5CA059DA279559F40002BEB4 /* Tests iOS */,
5CA059E6279559F40002BEB4 /* Tests macOS */,
5CA059CB279559F40002BEB4 /* Products */,
);
sourceTree = "<group>";
};
5CA059C2279559F40002BEB4 /* Shared */ = {
isa = PBXGroup;
children = (
5CA059C3279559F40002BEB4 /* SimpleXApp.swift */,
5CA059C4279559F40002BEB4 /* ContentView.swift */,
5CA05A4B27974EB60002BEB4 /* ProfileView.swift */,
5CA05A4E279752D00002BEB4 /* MessageView.swift */,
5CA059C5279559F40002BEB4 /* Assets.xcassets */,
);
path = Shared;
sourceTree = "<group>";
};
5CA059CB279559F40002BEB4 /* Products */ = {
isa = PBXGroup;
children = (
5CA059CA279559F40002BEB4 /* SimpleX.app */,
5CA059D0279559F40002BEB4 /* SimpleX.app */,
5CA059D7279559F40002BEB4 /* Tests iOS.xctest */,
5CA059E3279559F40002BEB4 /* Tests macOS.xctest */,
);
name = Products;
sourceTree = "<group>";
};
5CA059D1279559F40002BEB4 /* macOS */ = {
isa = PBXGroup;
children = (
5CA059D2279559F40002BEB4 /* macOS.entitlements */,
);
path = macOS;
sourceTree = "<group>";
};
5CA059DA279559F40002BEB4 /* Tests iOS */ = {
isa = PBXGroup;
children = (
5CA059DB279559F40002BEB4 /* Tests_iOS.swift */,
5CA059DD279559F40002BEB4 /* Tests_iOSLaunchTests.swift */,
);
path = "Tests iOS";
sourceTree = "<group>";
};
5CA059E6279559F40002BEB4 /* Tests macOS */ = {
isa = PBXGroup;
children = (
5CA059E7279559F40002BEB4 /* Tests_macOS.swift */,
5CA059E9279559F40002BEB4 /* Tests_macOSLaunchTests.swift */,
);
path = "Tests macOS";
sourceTree = "<group>";
};
/* End PBXGroup section */
/* Begin PBXNativeTarget section */
5CA059C9279559F40002BEB4 /* SimpleX (iOS) */ = {
isa = PBXNativeTarget;
buildConfigurationList = 5CA059F3279559F40002BEB4 /* Build configuration list for PBXNativeTarget "SimpleX (iOS)" */;
buildPhases = (
5CA059C6279559F40002BEB4 /* Sources */,
5CA059C7279559F40002BEB4 /* Frameworks */,
5CA059C8279559F40002BEB4 /* Resources */,
);
buildRules = (
);
dependencies = (
);
name = "SimpleX (iOS)";
productName = "SimpleX (iOS)";
productReference = 5CA059CA279559F40002BEB4 /* SimpleX.app */;
productType = "com.apple.product-type.application";
};
5CA059CF279559F40002BEB4 /* SimpleX (macOS) */ = {
isa = PBXNativeTarget;
buildConfigurationList = 5CA059F6279559F40002BEB4 /* Build configuration list for PBXNativeTarget "SimpleX (macOS)" */;
buildPhases = (
5CA059CC279559F40002BEB4 /* Sources */,
5CA059CD279559F40002BEB4 /* Frameworks */,
5CA059CE279559F40002BEB4 /* Resources */,
);
buildRules = (
);
dependencies = (
);
name = "SimpleX (macOS)";
productName = "SimpleX (macOS)";
productReference = 5CA059D0279559F40002BEB4 /* SimpleX.app */;
productType = "com.apple.product-type.application";
};
5CA059D6279559F40002BEB4 /* Tests iOS */ = {
isa = PBXNativeTarget;
buildConfigurationList = 5CA059F9279559F40002BEB4 /* Build configuration list for PBXNativeTarget "Tests iOS" */;
buildPhases = (
5CA059D3279559F40002BEB4 /* Sources */,
5CA059D4279559F40002BEB4 /* Frameworks */,
5CA059D5279559F40002BEB4 /* Resources */,
);
buildRules = (
);
dependencies = (
5CA059D9279559F40002BEB4 /* PBXTargetDependency */,
);
name = "Tests iOS";
productName = "Tests iOS";
productReference = 5CA059D7279559F40002BEB4 /* Tests iOS.xctest */;
productType = "com.apple.product-type.bundle.ui-testing";
};
5CA059E2279559F40002BEB4 /* Tests macOS */ = {
isa = PBXNativeTarget;
buildConfigurationList = 5CA059FC279559F40002BEB4 /* Build configuration list for PBXNativeTarget "Tests macOS" */;
buildPhases = (
5CA059DF279559F40002BEB4 /* Sources */,
5CA059E0279559F40002BEB4 /* Frameworks */,
5CA059E1279559F40002BEB4 /* Resources */,
);
buildRules = (
);
dependencies = (
5CA059E5279559F40002BEB4 /* PBXTargetDependency */,
);
name = "Tests macOS";
productName = "Tests macOS";
productReference = 5CA059E3279559F40002BEB4 /* Tests macOS.xctest */;
productType = "com.apple.product-type.bundle.ui-testing";
};
/* End PBXNativeTarget section */
/* Begin PBXProject section */
5CA059BE279559F40002BEB4 /* Project object */ = {
isa = PBXProject;
attributes = {
BuildIndependentTargetsInParallel = 1;
LastSwiftUpdateCheck = 1320;
LastUpgradeCheck = 1320;
TargetAttributes = {
5CA059C9279559F40002BEB4 = {
CreatedOnToolsVersion = 13.2.1;
};
5CA059CF279559F40002BEB4 = {
CreatedOnToolsVersion = 13.2.1;
};
5CA059D6279559F40002BEB4 = {
CreatedOnToolsVersion = 13.2.1;
TestTargetID = 5CA059C9279559F40002BEB4;
};
5CA059E2279559F40002BEB4 = {
CreatedOnToolsVersion = 13.2.1;
TestTargetID = 5CA059CF279559F40002BEB4;
};
};
};
buildConfigurationList = 5CA059C1279559F40002BEB4 /* Build configuration list for PBXProject "SimpleX" */;
compatibilityVersion = "Xcode 13.0";
developmentRegion = en;
hasScannedForEncodings = 0;
knownRegions = (
en,
Base,
);
mainGroup = 5CA059BD279559F40002BEB4;
productRefGroup = 5CA059CB279559F40002BEB4 /* Products */;
projectDirPath = "";
projectRoot = "";
targets = (
5CA059C9279559F40002BEB4 /* SimpleX (iOS) */,
5CA059CF279559F40002BEB4 /* SimpleX (macOS) */,
5CA059D6279559F40002BEB4 /* Tests iOS */,
5CA059E2279559F40002BEB4 /* Tests macOS */,
);
};
/* End PBXProject section */
/* Begin PBXResourcesBuildPhase section */
5CA059C8279559F40002BEB4 /* Resources */ = {
isa = PBXResourcesBuildPhase;
buildActionMask = 2147483647;
files = (
5CA059EF279559F40002BEB4 /* Assets.xcassets in Resources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059CE279559F40002BEB4 /* Resources */ = {
isa = PBXResourcesBuildPhase;
buildActionMask = 2147483647;
files = (
5CA059F0279559F40002BEB4 /* Assets.xcassets in Resources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059D5279559F40002BEB4 /* Resources */ = {
isa = PBXResourcesBuildPhase;
buildActionMask = 2147483647;
files = (
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059E1279559F40002BEB4 /* Resources */ = {
isa = PBXResourcesBuildPhase;
buildActionMask = 2147483647;
files = (
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXResourcesBuildPhase section */
/* Begin PBXSourcesBuildPhase section */
5CA059C6279559F40002BEB4 /* Sources */ = {
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
5CA05A4F279752D00002BEB4 /* MessageView.swift in Sources */,
5CA059ED279559F40002BEB4 /* ContentView.swift in Sources */,
5CA05A4C27974EB60002BEB4 /* ProfileView.swift in Sources */,
5CA059EB279559F40002BEB4 /* SimpleXApp.swift in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059CC279559F40002BEB4 /* Sources */ = {
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
5CA05A50279752D00002BEB4 /* MessageView.swift in Sources */,
5CA059EE279559F40002BEB4 /* ContentView.swift in Sources */,
5CA05A4D27974EB60002BEB4 /* ProfileView.swift in Sources */,
5CA059EC279559F40002BEB4 /* SimpleXApp.swift in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059D3279559F40002BEB4 /* Sources */ = {
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
5CA059DE279559F40002BEB4 /* Tests_iOSLaunchTests.swift in Sources */,
5CA059DC279559F40002BEB4 /* Tests_iOS.swift in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
5CA059DF279559F40002BEB4 /* Sources */ = {
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
5CA059EA279559F40002BEB4 /* Tests_macOSLaunchTests.swift in Sources */,
5CA059E8279559F40002BEB4 /* Tests_macOS.swift in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXSourcesBuildPhase section */
/* Begin PBXTargetDependency section */
5CA059D9279559F40002BEB4 /* PBXTargetDependency */ = {
isa = PBXTargetDependency;
target = 5CA059C9279559F40002BEB4 /* SimpleX (iOS) */;
targetProxy = 5CA059D8279559F40002BEB4 /* PBXContainerItemProxy */;
};
5CA059E5279559F40002BEB4 /* PBXTargetDependency */ = {
isa = PBXTargetDependency;
target = 5CA059CF279559F40002BEB4 /* SimpleX (macOS) */;
targetProxy = 5CA059E4279559F40002BEB4 /* PBXContainerItemProxy */;
};
/* End PBXTargetDependency section */
/* Begin XCBuildConfiguration section */
5CA059F1279559F40002BEB4 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
CLANG_ANALYZER_NONNULL = YES;
CLANG_ANALYZER_NUMBER_OBJECT_CONVERSION = YES_AGGRESSIVE;
CLANG_CXX_LANGUAGE_STANDARD = "gnu++17";
CLANG_CXX_LIBRARY = "libc++";
CLANG_ENABLE_MODULES = YES;
CLANG_ENABLE_OBJC_ARC = YES;
CLANG_ENABLE_OBJC_WEAK = YES;
CLANG_WARN_BLOCK_CAPTURE_AUTORELEASING = YES;
CLANG_WARN_BOOL_CONVERSION = YES;
CLANG_WARN_COMMA = YES;
CLANG_WARN_CONSTANT_CONVERSION = YES;
CLANG_WARN_DEPRECATED_OBJC_IMPLEMENTATIONS = YES;
CLANG_WARN_DIRECT_OBJC_ISA_USAGE = YES_ERROR;
CLANG_WARN_DOCUMENTATION_COMMENTS = YES;
CLANG_WARN_EMPTY_BODY = YES;
CLANG_WARN_ENUM_CONVERSION = YES;
CLANG_WARN_INFINITE_RECURSION = YES;
CLANG_WARN_INT_CONVERSION = YES;
CLANG_WARN_NON_LITERAL_NULL_CONVERSION = YES;
CLANG_WARN_OBJC_IMPLICIT_RETAIN_SELF = YES;
CLANG_WARN_OBJC_LITERAL_CONVERSION = YES;
CLANG_WARN_OBJC_ROOT_CLASS = YES_ERROR;
CLANG_WARN_QUOTED_INCLUDE_IN_FRAMEWORK_HEADER = YES;
CLANG_WARN_RANGE_LOOP_ANALYSIS = YES;
CLANG_WARN_STRICT_PROTOTYPES = YES;
CLANG_WARN_SUSPICIOUS_MOVE = YES;
CLANG_WARN_UNGUARDED_AVAILABILITY = YES_AGGRESSIVE;
CLANG_WARN_UNREACHABLE_CODE = YES;
CLANG_WARN__DUPLICATE_METHOD_MATCH = YES;
COPY_PHASE_STRIP = NO;
DEBUG_INFORMATION_FORMAT = dwarf;
ENABLE_STRICT_OBJC_MSGSEND = YES;
ENABLE_TESTABILITY = YES;
GCC_C_LANGUAGE_STANDARD = gnu11;
GCC_DYNAMIC_NO_PIC = NO;
GCC_NO_COMMON_BLOCKS = YES;
GCC_OPTIMIZATION_LEVEL = 0;
GCC_PREPROCESSOR_DEFINITIONS = (
"DEBUG=1",
"$(inherited)",
);
GCC_WARN_64_TO_32_BIT_CONVERSION = YES;
GCC_WARN_ABOUT_RETURN_TYPE = YES_ERROR;
GCC_WARN_UNDECLARED_SELECTOR = YES;
GCC_WARN_UNINITIALIZED_AUTOS = YES_AGGRESSIVE;
GCC_WARN_UNUSED_FUNCTION = YES;
GCC_WARN_UNUSED_VARIABLE = YES;
MTL_ENABLE_DEBUG_INFO = INCLUDE_SOURCE;
MTL_FAST_MATH = YES;
ONLY_ACTIVE_ARCH = YES;
SWIFT_ACTIVE_COMPILATION_CONDITIONS = DEBUG;
SWIFT_OPTIMIZATION_LEVEL = "-Onone";
};
name = Debug;
};
5CA059F2279559F40002BEB4 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
CLANG_ANALYZER_NONNULL = YES;
CLANG_ANALYZER_NUMBER_OBJECT_CONVERSION = YES_AGGRESSIVE;
CLANG_CXX_LANGUAGE_STANDARD = "gnu++17";
CLANG_CXX_LIBRARY = "libc++";
CLANG_ENABLE_MODULES = YES;
CLANG_ENABLE_OBJC_ARC = YES;
CLANG_ENABLE_OBJC_WEAK = YES;
CLANG_WARN_BLOCK_CAPTURE_AUTORELEASING = YES;
CLANG_WARN_BOOL_CONVERSION = YES;
CLANG_WARN_COMMA = YES;
CLANG_WARN_CONSTANT_CONVERSION = YES;
CLANG_WARN_DEPRECATED_OBJC_IMPLEMENTATIONS = YES;
CLANG_WARN_DIRECT_OBJC_ISA_USAGE = YES_ERROR;
CLANG_WARN_DOCUMENTATION_COMMENTS = YES;
CLANG_WARN_EMPTY_BODY = YES;
CLANG_WARN_ENUM_CONVERSION = YES;
CLANG_WARN_INFINITE_RECURSION = YES;
CLANG_WARN_INT_CONVERSION = YES;
CLANG_WARN_NON_LITERAL_NULL_CONVERSION = YES;
CLANG_WARN_OBJC_IMPLICIT_RETAIN_SELF = YES;
CLANG_WARN_OBJC_LITERAL_CONVERSION = YES;
CLANG_WARN_OBJC_ROOT_CLASS = YES_ERROR;
CLANG_WARN_QUOTED_INCLUDE_IN_FRAMEWORK_HEADER = YES;
CLANG_WARN_RANGE_LOOP_ANALYSIS = YES;
CLANG_WARN_STRICT_PROTOTYPES = YES;
CLANG_WARN_SUSPICIOUS_MOVE = YES;
CLANG_WARN_UNGUARDED_AVAILABILITY = YES_AGGRESSIVE;
CLANG_WARN_UNREACHABLE_CODE = YES;
CLANG_WARN__DUPLICATE_METHOD_MATCH = YES;
COPY_PHASE_STRIP = NO;
DEBUG_INFORMATION_FORMAT = "dwarf-with-dsym";
ENABLE_NS_ASSERTIONS = NO;
ENABLE_STRICT_OBJC_MSGSEND = YES;
GCC_C_LANGUAGE_STANDARD = gnu11;
GCC_NO_COMMON_BLOCKS = YES;
GCC_WARN_64_TO_32_BIT_CONVERSION = YES;
GCC_WARN_ABOUT_RETURN_TYPE = YES_ERROR;
GCC_WARN_UNDECLARED_SELECTOR = YES;
GCC_WARN_UNINITIALIZED_AUTOS = YES_AGGRESSIVE;
GCC_WARN_UNUSED_FUNCTION = YES;
GCC_WARN_UNUSED_VARIABLE = YES;
MTL_ENABLE_DEBUG_INFO = NO;
MTL_FAST_MATH = YES;
SWIFT_COMPILATION_MODE = wholemodule;
SWIFT_OPTIMIZATION_LEVEL = "-O";
};
name = Release;
};
5CA059F4279559F40002BEB4 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
ASSETCATALOG_COMPILER_APPICON_NAME = AppIcon;
ASSETCATALOG_COMPILER_GLOBAL_ACCENT_COLOR_NAME = AccentColor;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
ENABLE_PREVIEWS = YES;
GENERATE_INFOPLIST_FILE = YES;
INFOPLIST_KEY_UIApplicationSceneManifest_Generation = YES;
INFOPLIST_KEY_UIApplicationSupportsIndirectInputEvents = YES;
INFOPLIST_KEY_UILaunchScreen_Generation = YES;
INFOPLIST_KEY_UISupportedInterfaceOrientations_iPad = "UIInterfaceOrientationPortrait UIInterfaceOrientationPortraitUpsideDown UIInterfaceOrientationLandscapeLeft UIInterfaceOrientationLandscapeRight";
INFOPLIST_KEY_UISupportedInterfaceOrientations_iPhone = "UIInterfaceOrientationPortrait UIInterfaceOrientationLandscapeLeft UIInterfaceOrientationLandscapeRight";
IPHONEOS_DEPLOYMENT_TARGET = 15.2;
LD_RUNPATH_SEARCH_PATHS = (
"$(inherited)",
"@executable_path/Frameworks",
);
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleX;
PRODUCT_NAME = SimpleX;
SDKROOT = iphoneos;
SWIFT_EMIT_LOC_STRINGS = YES;
SWIFT_VERSION = 5.0;
TARGETED_DEVICE_FAMILY = "1,2";
};
name = Debug;
};
5CA059F5279559F40002BEB4 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
ASSETCATALOG_COMPILER_APPICON_NAME = AppIcon;
ASSETCATALOG_COMPILER_GLOBAL_ACCENT_COLOR_NAME = AccentColor;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
ENABLE_PREVIEWS = YES;
GENERATE_INFOPLIST_FILE = YES;
INFOPLIST_KEY_UIApplicationSceneManifest_Generation = YES;
INFOPLIST_KEY_UIApplicationSupportsIndirectInputEvents = YES;
INFOPLIST_KEY_UILaunchScreen_Generation = YES;
INFOPLIST_KEY_UISupportedInterfaceOrientations_iPad = "UIInterfaceOrientationPortrait UIInterfaceOrientationPortraitUpsideDown UIInterfaceOrientationLandscapeLeft UIInterfaceOrientationLandscapeRight";
INFOPLIST_KEY_UISupportedInterfaceOrientations_iPhone = "UIInterfaceOrientationPortrait UIInterfaceOrientationLandscapeLeft UIInterfaceOrientationLandscapeRight";
IPHONEOS_DEPLOYMENT_TARGET = 15.2;
LD_RUNPATH_SEARCH_PATHS = (
"$(inherited)",
"@executable_path/Frameworks",
);
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleX;
PRODUCT_NAME = SimpleX;
SDKROOT = iphoneos;
SWIFT_EMIT_LOC_STRINGS = YES;
SWIFT_VERSION = 5.0;
TARGETED_DEVICE_FAMILY = "1,2";
VALIDATE_PRODUCT = YES;
};
name = Release;
};
5CA059F7279559F40002BEB4 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
ASSETCATALOG_COMPILER_APPICON_NAME = AppIcon;
ASSETCATALOG_COMPILER_GLOBAL_ACCENT_COLOR_NAME = AccentColor;
CODE_SIGN_ENTITLEMENTS = macOS/macOS.entitlements;
CODE_SIGN_STYLE = Automatic;
COMBINE_HIDPI_IMAGES = YES;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
ENABLE_HARDENED_RUNTIME = YES;
ENABLE_PREVIEWS = YES;
GENERATE_INFOPLIST_FILE = YES;
INFOPLIST_KEY_NSHumanReadableCopyright = "";
LD_RUNPATH_SEARCH_PATHS = (
"$(inherited)",
"@executable_path/../Frameworks",
);
MACOSX_DEPLOYMENT_TARGET = 12.1;
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleX;
PRODUCT_NAME = SimpleX;
SDKROOT = macosx;
SWIFT_EMIT_LOC_STRINGS = YES;
SWIFT_VERSION = 5.0;
};
name = Debug;
};
5CA059F8279559F40002BEB4 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
ASSETCATALOG_COMPILER_APPICON_NAME = AppIcon;
ASSETCATALOG_COMPILER_GLOBAL_ACCENT_COLOR_NAME = AccentColor;
CODE_SIGN_ENTITLEMENTS = macOS/macOS.entitlements;
CODE_SIGN_STYLE = Automatic;
COMBINE_HIDPI_IMAGES = YES;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
ENABLE_HARDENED_RUNTIME = YES;
ENABLE_PREVIEWS = YES;
GENERATE_INFOPLIST_FILE = YES;
INFOPLIST_KEY_NSHumanReadableCopyright = "";
LD_RUNPATH_SEARCH_PATHS = (
"$(inherited)",
"@executable_path/../Frameworks",
);
MACOSX_DEPLOYMENT_TARGET = 12.1;
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleX;
PRODUCT_NAME = SimpleX;
SDKROOT = macosx;
SWIFT_EMIT_LOC_STRINGS = YES;
SWIFT_VERSION = 5.0;
};
name = Release;
};
5CA059FA279559F40002BEB4 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_EMBED_SWIFT_STANDARD_LIBRARIES = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
GENERATE_INFOPLIST_FILE = YES;
IPHONEOS_DEPLOYMENT_TARGET = 15.2;
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.Tests-iOS";
PRODUCT_NAME = "$(TARGET_NAME)";
SDKROOT = iphoneos;
SWIFT_EMIT_LOC_STRINGS = NO;
SWIFT_VERSION = 5.0;
TARGETED_DEVICE_FAMILY = "1,2";
TEST_TARGET_NAME = "SimpleX (iOS)";
};
name = Debug;
};
5CA059FB279559F40002BEB4 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_EMBED_SWIFT_STANDARD_LIBRARIES = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
GENERATE_INFOPLIST_FILE = YES;
IPHONEOS_DEPLOYMENT_TARGET = 15.2;
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.Tests-iOS";
PRODUCT_NAME = "$(TARGET_NAME)";
SDKROOT = iphoneos;
SWIFT_EMIT_LOC_STRINGS = NO;
SWIFT_VERSION = 5.0;
TARGETED_DEVICE_FAMILY = "1,2";
TEST_TARGET_NAME = "SimpleX (iOS)";
VALIDATE_PRODUCT = YES;
};
name = Release;
};
5CA059FD279559F40002BEB4 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_EMBED_SWIFT_STANDARD_LIBRARIES = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
GENERATE_INFOPLIST_FILE = YES;
MACOSX_DEPLOYMENT_TARGET = 12.1;
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.Tests-macOS";
PRODUCT_NAME = "$(TARGET_NAME)";
SDKROOT = macosx;
SWIFT_EMIT_LOC_STRINGS = NO;
SWIFT_VERSION = 5.0;
TEST_TARGET_NAME = "SimpleX (macOS)";
};
name = Debug;
};
5CA059FE279559F40002BEB4 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_EMBED_SWIFT_STANDARD_LIBRARIES = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 1;
DEVELOPMENT_TEAM = 9767FTRA3G;
GENERATE_INFOPLIST_FILE = YES;
MACOSX_DEPLOYMENT_TARGET = 12.1;
MARKETING_VERSION = 1.0;
PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.Tests-macOS";
PRODUCT_NAME = "$(TARGET_NAME)";
SDKROOT = macosx;
SWIFT_EMIT_LOC_STRINGS = NO;
SWIFT_VERSION = 5.0;
TEST_TARGET_NAME = "SimpleX (macOS)";
};
name = Release;
};
/* End XCBuildConfiguration section */
/* Begin XCConfigurationList section */
5CA059C1279559F40002BEB4 /* Build configuration list for PBXProject "SimpleX" */ = {
isa = XCConfigurationList;
buildConfigurations = (
5CA059F1279559F40002BEB4 /* Debug */,
5CA059F2279559F40002BEB4 /* Release */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Release;
};
5CA059F3279559F40002BEB4 /* Build configuration list for PBXNativeTarget "SimpleX (iOS)" */ = {
isa = XCConfigurationList;
buildConfigurations = (
5CA059F4279559F40002BEB4 /* Debug */,
5CA059F5279559F40002BEB4 /* Release */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Release;
};
5CA059F6279559F40002BEB4 /* Build configuration list for PBXNativeTarget "SimpleX (macOS)" */ = {
isa = XCConfigurationList;
buildConfigurations = (
5CA059F7279559F40002BEB4 /* Debug */,
5CA059F8279559F40002BEB4 /* Release */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Release;
};
5CA059F9279559F40002BEB4 /* Build configuration list for PBXNativeTarget "Tests iOS" */ = {
isa = XCConfigurationList;
buildConfigurations = (
5CA059FA279559F40002BEB4 /* Debug */,
5CA059FB279559F40002BEB4 /* Release */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Release;
};
5CA059FC279559F40002BEB4 /* Build configuration list for PBXNativeTarget "Tests macOS" */ = {
isa = XCConfigurationList;
buildConfigurations = (
5CA059FD279559F40002BEB4 /* Debug */,
5CA059FE279559F40002BEB4 /* Release */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Release;
};
/* End XCConfigurationList section */
};
rootObject = 5CA059BE279559F40002BEB4 /* Project object */;
}

7
apps/ios/SimpleX.xcodeproj/project.xcworkspace/contents.xcworkspacedata generated Normal file
View file

@ -0,0 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<Workspace
version = "1.0">
<FileRef
location = "self:">
</FileRef>
</Workspace>

8
apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/IDEWorkspaceChecks.plist Normal file
View file

@ -0,0 +1,8 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
<key>IDEDidComputeMac32BitWarning</key>
<true/>
</dict>
</plist>

42
apps/ios/Tests iOS/Tests_iOS.swift Normal file
View file

@ -0,0 +1,42 @@
//
// Tests_iOS.swift
// Tests iOS
//
// Created by Evgeny Poberezkin on 17/01/2022.
//
import XCTest
class Tests_iOS: XCTestCase {
override func setUpWithError() throws {
// Put setup code here. This method is called before the invocation of each test method in the class.
// In UI tests it is usually best to stop immediately when a failure occurs.
continueAfterFailure = false
// In UI tests it’s important to set the initial state - such as interface orientation - required for your tests before they run. The setUp method is a good place to do this.
}
override func tearDownWithError() throws {
// Put teardown code here. This method is called after the invocation of each test method in the class.
}
func testExample() throws {
// UI tests must launch the application that they test.
let app = XCUIApplication()
app.launch()
// Use recording to get started writing UI tests.
// Use XCTAssert and related functions to verify your tests produce the correct results.
}
func testLaunchPerformance() throws {
if #available(macOS 10.15, iOS 13.0, tvOS 13.0, watchOS 7.0, *) {
// This measures how long it takes to launch your application.
measure(metrics: [XCTApplicationLaunchMetric()]) {
XCUIApplication().launch()
}
}
}
}

32
apps/ios/Tests iOS/Tests_iOSLaunchTests.swift Normal file
View file

@ -0,0 +1,32 @@
//
// Tests_iOSLaunchTests.swift
// Tests iOS
//
// Created by Evgeny Poberezkin on 17/01/2022.
//
import XCTest
class Tests_iOSLaunchTests: XCTestCase {
override class var runsForEachTargetApplicationUIConfiguration: Bool {
true
}
override func setUpWithError() throws {
continueAfterFailure = false
}
func testLaunch() throws {
let app = XCUIApplication()
app.launch()
// Insert steps here to perform after app launch but before taking a screenshot,
// such as logging into a test account or navigating somewhere in the app
let attachment = XCTAttachment(screenshot: app.screenshot())
attachment.name = "Launch Screen"
attachment.lifetime = .keepAlways
add(attachment)
}
}

42
apps/ios/Tests macOS/Tests_macOS.swift Normal file
View file

@ -0,0 +1,42 @@
//
// Tests_macOS.swift
// Tests macOS
//
// Created by Evgeny Poberezkin on 17/01/2022.
//
import XCTest
class Tests_macOS: XCTestCase {
override func setUpWithError() throws {
// Put setup code here. This method is called before the invocation of each test method in the class.
// In UI tests it is usually best to stop immediately when a failure occurs.
continueAfterFailure = false
// In UI tests it’s important to set the initial state - such as interface orientation - required for your tests before they run. The setUp method is a good place to do this.
}
override func tearDownWithError() throws {
// Put teardown code here. This method is called after the invocation of each test method in the class.
}
func testExample() throws {
// UI tests must launch the application that they test.
let app = XCUIApplication()
app.launch()
// Use recording to get started writing UI tests.
// Use XCTAssert and related functions to verify your tests produce the correct results.
}
func testLaunchPerformance() throws {
if #available(macOS 10.15, iOS 13.0, tvOS 13.0, watchOS 7.0, *) {
// This measures how long it takes to launch your application.
measure(metrics: [XCTApplicationLaunchMetric()]) {
XCUIApplication().launch()
}
}
}
}

32
apps/ios/Tests macOS/Tests_macOSLaunchTests.swift Normal file
View file

@ -0,0 +1,32 @@
//
// Tests_macOSLaunchTests.swift
// Tests macOS
//
// Created by Evgeny Poberezkin on 17/01/2022.
//
import XCTest
class Tests_macOSLaunchTests: XCTestCase {
override class var runsForEachTargetApplicationUIConfiguration: Bool {
true
}
override func setUpWithError() throws {
continueAfterFailure = false
}
func testLaunch() throws {
let app = XCUIApplication()
app.launch()
// Insert steps here to perform after app launch but before taking a screenshot,
// such as logging into a test account or navigating somewhere in the app
let attachment = XCTAttachment(screenshot: app.screenshot())
attachment.name = "Launch Screen"
attachment.lifetime = .keepAlways
add(attachment)
}
}

10
apps/ios/macOS/macOS.entitlements Normal file
View file

@ -0,0 +1,10 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
<key>com.apple.security.app-sandbox</key>
<true/>
<key>com.apple.security.files.user-selected.read-only</key>
<true/>
</dict>
</plist>

5
apps/simplex-chat/Main.hs
View file

@ -8,6 +8,7 @@ module Main where
import Simplex.Chat
import Simplex.Chat.Controller (versionNumber)
import Simplex.Chat.Options
import Simplex.Chat.Terminal
import System.Directory (getAppUserDataDirectory)
import System.Terminal (withTerminal)
@ -20,8 +21,8 @@ main = do
welcomeGetOpts :: IO ChatOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@ChatOpts {dbFile} <- getChatOpts appDir
opts@ChatOpts {dbFilePrefix} <- getChatOpts appDir
putStrLn $ "SimpleX Chat v" ++ versionNumber
putStrLn $ "db: " <> dbFile <> "_chat.db, " <> dbFile <> "_agent.db"
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
putStrLn "type \"/help\" or \"/h\" for usage info"
pure opts

7
cabal.project
View file

@ -1,9 +1,14 @@
packages: .
source-repository-package
type: git
location: git://github.com/simplex-chat/simplexmq.git
tag: 670b3b79749bfb48a04ee40b8c441e9ca68ad41a
source-repository-package
type: git
location: git://github.com/simplex-chat/hs-tls.git
tag: cea6d52c512716ff09adcac86ebc95bb0b3bb797
tag: f6cc753611f80af300401cfae63846e9d7c40d9e
subdir: core
source-repository-package

2
package.yaml
View file

@ -10,7 +10,6 @@ copyright: 2020-22 simplex.chat
category: Web, System, Services, Cryptography
extra-source-files:
- README.md
- migrations/*.*
dependencies:
- aeson == 1.5.*
@ -24,7 +23,6 @@ dependencies:
- cryptonite >= 0.27 && < 0.30
- directory == 1.3.*
- exceptions == 0.10.*
- file-embed >= 0.0.14 && < 0.0.16
- filepath == 1.4.*
- mtl == 2.2.*
- optparse-applicative >= 0.15 && < 0.17

167
rfcs/2022-01-26-mobile-app.md Normal file
View file

@ -0,0 +1,167 @@
# Porting SimpleX Chat to mobile
## Background and motivation
We have code that "works", the aim is to keep platform differences in the core minimal and get the apps to market faster.
### SimpleX platform design
See [overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md) for overall platform design and objectives, it is worth reading the introduction. The diagram copied from this doc:
```
User's Computer Internet Third-Party Server
------------------ | ---------------------- | -------------------------
| |
SimpleX Chat | |
| |
+----------------+ | |
| Chat App | | |
+----------------+ | |
| SimpleX Agent | | |
+----------------+ -------------- TLS ---------------- +----------------+
| SimpleX Client | ------ SimpleX Messaging Protocol ------> | SimpleX Server |
+----------------+ ----------------------------------- +----------------+
| |
```
- SimpleX Servers only pass messages, we don't need to touch that for the app
- SimpleX clients talk to the servers, we won't use them directly
- SimpleX agent is used from chat, we won't use it directly from the app
- Chat app will expose API to the app to communicate with everything, including DB and network.
### Important application modules
Modules of simplexmq package used from simplex-chat:
- a [functional API in Agent.hs]([Agent.hs](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Agent.hs#L38)) to send messages and commands
- TBQueue to receive messages and notifications (specifically, [subQ field of AgentClient record in Agent/Client.hs](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Agent/Client.hs#L72))
- [types from Agent/Protocol.hs](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Agent/Protocol.hs)).
This package has its [own sqlite database file](https://github.com/simplex-chat/simplexmq/tree/master/migrations) - as v1 was not backwards compatible migrations are restarted - where it stores all encryption and signing keys, shared secrets, servers and queue addresses - effectively it completely abstracts the network away from chat application, providing an API to manage logical duplex connections.
Simplex-chat library is what we will use from the app:
- command type [ChatCommand in Chat.hs](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat.hs#L72) that UI can send to it
- UI sends these commands via TBQueue that `inputSubscriber` reads in forever loop and sends to `processChatCommand`. There is a hack that `inputSubscriber` not only reads commands but also shows them in the view, depending on the commands.
- collection of [view functions in Chat/View.hs](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat/View.hs) to reflect all events in view.
This package also creates its own [database file](https://github.com/simplex-chat/simplex-chat/tree/master/migrations) where it stores references to agent connections managed by the agent, and how they map to contacts, groups, and file transmissions.
## App design options and questions
### Sending chat commands from UI and receiving them in Haskell
Possible options:
- function (exported via FFI) that receives strings from UI and decodes them into ChatCommand type, then sending this command to `processChatCommand`. This option requires a single function in C header file, but also requires encoding in UI and decoding in Haskell.
- multiple functions exported via FFI each sending different command to `processChatCommand`. This option requires multiple functions in header file and multiple exports from Haskell.
Overall, the second option seems a bit simpler and cleaner, if we agree to go this route we will refactor `processChatCommand` to expose its parts that process different commands as independent functions.
On another hand, it might be easier to grow chat API if this is passed via a single function and serialized as strings (e.g. as JSON, to have it more universal) - it would also might give us an API for a possible future chat server that works with thin, UI-only clients.
In both cases, we should split `processChatCommand` (or the functions it calls) into a separate module, so it does not have code that is not used from the app.
**Proposal**
Use option 2 to send commands from UI to chat, encoding/decoding commands as strings with a tag in the beginning (TBC binary, text or JSON based - encoding will have to be replicated in UI land; both encoding and decoding is needed in Haskell land to refactor terminal chat to use this layer as well, so we have a standard API for all implementations).
This function would have this type:
```haskell
sendRequest :: CString -> IO CString
```
to allow instant responses.
One more idea. This function could be made to match REST semantics that would simplify making chat into a REST chat server api:
```haskell
sendRequest :: CString -> CString -> CString -> CString -> IO CString
sendRequest verb path qs body = pure ""
```
### Sending messages and notifications from Haskell to UI
Firstly, we have to refactor the existing code so that all functions in [View.hs](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat/View.hs) are passed to `processChatCommand` (or the functions for each command, if we go with this approach) as a single record containing all view functions.
The current code from View.hs will not be used in the mobile app, it is terminal specific; we will create a separate connector to the UI that has the same functions in a record - these functions communicate to the UI.
Again, there are two similar options how this communication can happen:
- UIs would export multiple functions however each platform allows it, as C exports, and they would be all imported in Haskell. This option feels definitely worse, as it would have to be maintained in both iOS and Android separately for exports, and in Haskell for imports, resulting in lots of boilerplate.
- UIs would export one function that receives strings (e.g. JSON encoded) with the messages and notifications, there will be one function in Haskell to send these JSON. All required view functions in Haskell land would simply send different strings into the same function.
In this case the second option seems definitely easier, as even with simple terminal UI there are more view events than chat commands (although, given different mobile UI paradigms some of these events may not be needed, but some additional events are likely to be addedd, that would be doing nothing for terminal app).
**Proposal**
Encode messages and notifications as JSON, but instead of exporting the function from UI (which would have to be done differently from different platforms), have Haskell export function `receiveMessage` that would be blocking until the next notification or message is available. UI would handle it in a simple loop, on a separate thread:
```haskell
-- CString is serialized JSON (ToJSON serialized datatype from haskell)
receiveMessage :: IO CString ()
```
To convert between Haskell and C interface:
```haskell
type CJSON = CString
toCJSON ToJSON a => a -> CJSON
toCJSON = ...
-- Haskell interface
send :: ToJSON a => String -> IO a
recv :: ToJSON a => IO a
-- C interface
c_send :: CString -> IO CJSON
c_recv :: IO CJSON
```
### Accessing chat database from the UI
Unlike terminal UI that does not provide any capabilities to access chat history, mobile UI needs to have access to it.
Two options how it can be done:
- UI accesses database directly via its own database library. The upside of this approach is that it keeps Haskel core smaller. The downside is that sqlite is relatively bad with concurrent access. In Haskell code we allowed some concurrency initially, having the pool limited to few concurrent connection, but later we removed concurrency (by limiting pool size to 1), as otherwise it required retrying to get transaction locks with difficult to set retry time limits, and leading to deadlocks in some cases. Also mobile sqlite seems to be compiled with concurrency disabled, so we would have to ship app with our own sqlite (which we might have to do anyway, for the sake of full text search support). We could use some shared semaphore in Haskell to obtain database lock, but it adds extra complexity...
- UI accesses database via Haskell functions. The upside of this is that there would be no issues with concurrency, and chat schema would be "owned" by Haskell core, but it requires either a separate serializable protocol for database access or multiple exported functions (same two options as before).
However bad the second option is, it seems slightly better as at least we would not have to duplicate sql quiries in iOS and Android. But this is the trade-off I am least certain of...
**Proposal**
Use the same `sendRequest` function to access database.
Additional idea: as these calls should never mutate chat database, they should only query the state, and as these functions will not be needed for terminal UI, I think we could export it as a separate function and have all necessary queries/functions in a separate module, e.g.:
```haskell
-- params and result are JSON encoded
chatQuery :: CString -> IO CString
chatQuery params = pure ""
```
On another hand, if we go with REST-like `sendRequest` then it definitely should be the only function to access chat and database state.
### UI database
UI needs to have its own storage to store information about user settings in the app and, possibly, which chat profiles the user has (each would have its own chat/agent databases).
### Chat database initialization
Currently it is done in an ad hoc way, during the application start ([`getCreateActiveUser` function](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat.hs#L1178)), we could either expose this function to accept database name or just check on the start and initialize database with the default name in case it is not present.
### Multiple profiles in the app
All user profiles are stored in the same database. The current schema allows multiple profiles, but the current UI does not. We do not need to do it in the app MVP.
## Notifications
We don't need it in the first version - it is out of scope of releasable MVP - but we need to think a bit ahead how it will be done so it doesn't invalidate the design we settle on.
There is no reliable background execution, so the only way to receive messages when the app is off is via notifications. We have added notification subscriptions to the low protocol layer so that Haskell core would receive function call when notification arrives to the native part and receive and process messages and communicate back to the local part that would show a local notification on the device:
```
Push notification -> Native -> Haskell ... process ... -> Native -> Local notification
```
Notifications are the main reason why we will need to store multiple profiles in the same database file - when notification arrives we do not know which profile it is for, it only has server address and queue ID, and if different profiles were in different databases we would either had to have a single table mapping queues to profiles or lookup multiple databases - both options seem worse than a single database with multiple profiles.
For the rest we would just use the same approaches we would use for UI/Haskell communications - probably a separate functions to receive notifications to Haskell, and the same events to be sent back.

11
simplex-chat.cabal
View file

@ -16,21 +16,23 @@ license-file: LICENSE
build-type: Simple
extra-source-files:
README.md
migrations/20220101_initial.sql
library
exposed-modules:
Simplex.Chat
Simplex.Chat.Controller
Simplex.Chat.Help
Simplex.Chat.Input
Simplex.Chat.Markdown
Simplex.Chat.Notification
Simplex.Chat.Migrations.M20220101_initial
Simplex.Chat.Mobile
Simplex.Chat.Options
Simplex.Chat.Protocol
Simplex.Chat.Store
Simplex.Chat.Styled
Simplex.Chat.Terminal
Simplex.Chat.Terminal.Input
Simplex.Chat.Terminal.Output
Simplex.Chat.Terminal.Notification
Simplex.Chat.Types
Simplex.Chat.Util
Simplex.Chat.View
@ -51,7 +53,6 @@ library
, cryptonite >=0.27 && <0.30
, directory ==1.3.*
, exceptions ==0.10.*
, file-embed >=0.0.14 && <0.0.16
, filepath ==1.4.*
, mtl ==2.2.*
, optparse-applicative >=0.15 && <0.17
@ -87,7 +88,6 @@ executable simplex-chat
, cryptonite >=0.27 && <0.30
, directory ==1.3.*
, exceptions ==0.10.*
, file-embed >=0.0.14 && <0.0.16
, filepath ==1.4.*
, mtl ==2.2.*
, optparse-applicative >=0.15 && <0.17
@ -130,7 +130,6 @@ test-suite simplex-chat-test
, cryptonite >=0.27 && <0.30
, directory ==1.3.*
, exceptions ==0.10.*
, file-embed >=0.0.14 && <0.0.16
, filepath ==1.4.*
, hspec ==2.7.*
, mtl ==2.2.*

255
src/Simplex/Chat.hs
View file

@ -38,15 +38,12 @@ import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
import Simplex.Chat.Controller
import Simplex.Chat.Help
import Simplex.Chat.Input
import Simplex.Chat.Notification
import Simplex.Chat.Options (ChatOpts (..))
import Simplex.Chat.Protocol
import Simplex.Chat.Store
import Simplex.Chat.Styled (plain)
import Simplex.Chat.Terminal
import Simplex.Chat.Styled
import Simplex.Chat.Types
import Simplex.Chat.Util (ifM, unlessM, whenM)
import Simplex.Chat.Util (ifM, unlessM)
import Simplex.Chat.View
import Simplex.Messaging.Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig)
@ -62,7 +59,6 @@ import System.Exit (exitFailure, exitSuccess)
import System.FilePath (combine, splitExtensions, takeFileName)
import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
import Text.Read (readMaybe)
import UnliftIO.Async (race_)
import UnliftIO.Concurrent (forkIO, threadDelay)
import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getFileSize, getHomeDirectory, getTemporaryDirectory)
import qualified UnliftIO.Exception as E
@ -126,45 +122,29 @@ defaultChatConfig =
logCfg :: LogConfig
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
simplexChat :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChat cfg opts@ChatOpts {logging} t
| logging = do
setLogLevel LogInfo -- LogError
withGlobalLogging logCfg initRun
| otherwise = initRun
where
initRun =
initializeNotifications
>>= newChatController cfg opts t
>>= runSimplexChat
newChatController :: WithTerminal t => ChatConfig -> ChatOpts -> t -> (Notification -> IO ()) -> IO ChatController
newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} ChatOpts {dbFile, smpServers} t sendNotification = do
let f = chatStoreFile dbFile
newChatController :: SQLiteStore -> User -> ChatConfig -> ChatOpts -> (Notification -> IO ()) -> IO ChatController
newChatController chatStore user config@ChatConfig {agentConfig = cfg, tbqSize} ChatOpts {dbFilePrefix, smpServers} sendNotification = do
let f = chatStoreFile dbFilePrefix
activeTo <- newTVarIO ActiveNone
firstTime <- not <$> doesFileExist f
chatStore <- createStore f dbPoolSize
currentUser <- newTVarIO =<< getCreateActiveUser chatStore
chatTerminal <- newChatTerminal t
smpAgent <- getSMPAgentClient cfg {dbFile = dbFile <> "_agent.db", smpServers}
currentUser <- newTVarIO user
smpAgent <- getSMPAgentClient cfg {dbFile = dbFilePrefix <> "_agent.db", smpServers}
idsDrg <- newTVarIO =<< drgNew
inputQ <- newTBQueueIO tbqSize
outputQ <- newTBQueueIO tbqSize
notifyQ <- newTBQueueIO tbqSize
chatLock <- newTMVarIO ()
sndFiles <- newTVarIO M.empty
rcvFiles <- newTVarIO M.empty
pure ChatController {..}
runSimplexChat :: ChatController -> IO ()
runSimplexChat = runReaderT $ do
user <- readTVarIO =<< asks currentUser
whenM (asks firstTime) . printToView $ chatWelcome user
race_ runTerminalInput runChatController
pure ChatController {activeTo, firstTime, currentUser, smpAgent, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, config, sendNotification}
runChatController :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
runChatController =
runChatController = do
q <- asks outputQ
let toView = atomically . writeTBQueue q
raceAny_
[ inputSubscriber,
agentSubscriber,
[ inputSubscriber toView,
agentSubscriber toView,
notificationSubscriber
]
@ -174,8 +154,8 @@ withLock lock =
(void . atomically $ takeTMVar lock)
(atomically $ putTMVar lock ())
inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
inputSubscriber = do
inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => ([StyledString] -> m ()) -> m ()
inputSubscriber toView = do
q <- asks inputQ
l <- asks chatLock
a <- asks smpAgent
@ -184,34 +164,36 @@ inputSubscriber = do
InputControl _ -> pure ()
InputCommand s ->
case parseAll chatCommandP . B.dropWhileEnd isSpace . encodeUtf8 $ T.pack s of
Left e -> printToView [plain s, "invalid input: " <> plain e]
Left e -> toView [plain s, "invalid input: " <> plain e]
Right cmd -> do
case cmd of
SendMessage c msg -> showSentMessage c msg
SendGroupMessage g msg -> showSentGroupMessage g msg
SendFile c f -> showSentFileInvitation c f
SendGroupFile g f -> showSentGroupFileInvitation g f
_ -> printToView [plain s]
SendMessage c msg -> toView =<< liftIO (viewSentMessage c msg)
SendGroupMessage g msg -> toView =<< liftIO (viewSentGroupMessage g msg)
SendFile c f -> toView =<< liftIO (viewSentFileInvitation c f)
SendGroupFile g f -> toView =<< liftIO (viewSentGroupFileInvitation g f)
_ -> toView [plain s]
user <- readTVarIO =<< asks currentUser
withAgentLock a . withLock l . void . runExceptT $
processChatCommand user cmd `catchError` showChatError
processChatCommand toView' user cmd `catchError` (toView' . viewChatError)
where
toView' = ExceptT . fmap Right . toView
processChatCommand :: forall m. ChatMonad m => User -> ChatCommand -> m ()
processChatCommand user@User {userId, profile} = \case
ChatHelp -> printToView chatHelpInfo
FilesHelp -> printToView filesHelpInfo
GroupsHelp -> printToView groupsHelpInfo
MyAddressHelp -> printToView myAddressHelpInfo
MarkdownHelp -> printToView markdownInfo
Welcome -> printToView $ chatWelcome user
processChatCommand :: forall m. ChatMonad m => ([StyledString] -> m ()) -> User -> ChatCommand -> m ()
processChatCommand toView user@User {userId, profile} = \case
ChatHelp -> toView chatHelpInfo
FilesHelp -> toView filesHelpInfo
GroupsHelp -> toView groupsHelpInfo
MyAddressHelp -> toView myAddressHelpInfo
MarkdownHelp -> toView markdownInfo
Welcome -> toView $ chatWelcome user
AddContact -> do
(connId, cReq) <- withAgent (`createConnection` SCMInvitation)
withStore $ \st -> createDirectConnection st userId connId
showInvitation cReq
Connect (Just (ACR SCMInvitation cReq)) -> connect cReq (XInfo profile) >> showSentConfirmation
Connect (Just (ACR SCMContact cReq)) -> connect cReq (XContact profile Nothing) >> showSentInvitation
Connect Nothing -> showInvalidConnReq
ConnectAdmin -> connect adminContactReq (XContact profile Nothing) >> showSentInvitation
toView $ viewConnReqInvitation cReq
Connect (Just (ACR SCMInvitation cReq)) -> connect cReq (XInfo profile) >> toView viewSentConfirmation
Connect (Just (ACR SCMContact cReq)) -> connect cReq (XContact profile Nothing) >> toView viewSentInvitation
Connect Nothing -> toView viewInvalidConnReq
ConnectAdmin -> connect adminContactReq (XContact profile Nothing) >> toView viewSentInvitation
DeleteContact cName ->
withStore (\st -> getContactGroupNames st userId cName) >>= \case
[] -> do
@ -220,39 +202,39 @@ processChatCommand user@User {userId, profile} = \case
deleteConnection a agentConnId `catchError` \(_ :: AgentErrorType) -> pure ()
withStore $ \st -> deleteContact st userId cName
unsetActive $ ActiveC cName
showContactDeleted cName
gs -> showContactGroups cName gs
ListContacts -> withStore (`getUserContacts` user) >>= showContactsList
toView $ viewContactDeleted cName
gs -> toView $ viewContactGroups cName gs
ListContacts -> withStore (`getUserContacts` user) >>= toView . viewContactsList
CreateMyAddress -> do
(connId, cReq) <- withAgent (`createConnection` SCMContact)
withStore $ \st -> createUserContactLink st userId connId cReq
showUserContactLinkCreated cReq
toView $ viewUserContactLinkCreated cReq
DeleteMyAddress -> do
conns <- withStore $ \st -> getUserContactLinkConnections st userId
withAgent $ \a -> forM_ conns $ \Connection {agentConnId} ->
deleteConnection a agentConnId `catchError` \(_ :: AgentErrorType) -> pure ()
withStore $ \st -> deleteUserContactLink st userId
showUserContactLinkDeleted
toView viewUserContactLinkDeleted
ShowMyAddress -> do
cReq <- withStore $ \st -> getUserContactLink st userId
showUserContactLink cReq
toView $ viewUserContactLink cReq
AcceptContact cName -> do
UserContactRequest {agentInvitationId, profileId} <- withStore $ \st ->
getContactRequest st userId cName
connId <- withAgent $ \a -> acceptContact a agentInvitationId . directMessage $ XInfo profile
withStore $ \st -> createAcceptedContact st userId connId cName profileId
showAcceptingContactRequest cName
toView $ viewAcceptingContactRequest cName
RejectContact cName -> do
UserContactRequest {agentContactConnId, agentInvitationId} <- withStore $ \st ->
getContactRequest st userId cName
`E.finally` deleteContactRequest st userId cName
withAgent $ \a -> rejectContact a agentContactConnId agentInvitationId
showContactRequestRejected cName
toView $ viewContactRequestRejected cName
SendMessage cName msg -> sendMessageCmd cName msg
NewGroup gProfile -> do
gVar <- asks idsDrg
group <- withStore $ \st -> createNewGroup st gVar user gProfile
showGroupCreated group
toView $ viewGroupCreated group
AddMember gName cName memRole -> do
(group, contact) <- withStore $ \st -> (,) <$> getGroup st user gName <*> getContact st userId cName
let Group {groupId, groupProfile, membership, members} = group
@ -263,7 +245,7 @@ processChatCommand user@User {userId, profile} = \case
let sendInvitation memberId cReq = do
sendDirectMessage (contactConn contact) $
XGrpInv $ GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
showSentGroupInvitation gName cName
toView $ viewSentGroupInvitation gName cName
setActive $ ActiveG gName
case contactMember contact members of
Nothing -> do
@ -275,7 +257,7 @@ processChatCommand user@User {userId, profile} = \case
| memberStatus == GSMemInvited ->
withStore (\st -> getMemberInvitation st user groupMemberId) >>= \case
Just cReq -> sendInvitation memberId cReq
Nothing -> showCannotResendInvitation gName cName
Nothing -> toView $ viewCannotResendInvitation gName cName
| otherwise -> chatError (CEGroupDuplicateMember cName)
JoinGroup gName -> do
ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
@ -295,13 +277,13 @@ processChatCommand user@User {userId, profile} = \case
when (mStatus /= GSMemInvited) . sendGroupMessage members $ XGrpMemDel mId
deleteMemberConnection m
withStore $ \st -> updateGroupMemberStatus st userId m GSMemRemoved
showDeletedMember gName Nothing (Just m)
toView $ viewDeletedMember gName Nothing (Just m)
LeaveGroup gName -> do
Group {membership, members} <- withStore $ \st -> getGroup st user gName
sendGroupMessage members XGrpLeave
mapM_ deleteMemberConnection members
withStore $ \st -> updateGroupMemberStatus st userId membership GSMemLeft
showLeftMemberUser gName
toView $ viewLeftMemberUser gName
DeleteGroup gName -> do
g@Group {membership, members} <- withStore $ \st -> getGroup st user gName
let s = memberStatus membership
@ -312,11 +294,11 @@ processChatCommand user@User {userId, profile} = \case
when (memberActive membership) $ sendGroupMessage members XGrpDel
mapM_ deleteMemberConnection members
withStore $ \st -> deleteGroup st user g
showGroupDeletedUser gName
toView $ viewGroupDeletedUser gName
ListMembers gName -> do
group <- withStore $ \st -> getGroup st user gName
showGroupMembers group
ListGroups -> withStore (`getUserGroupDetails` userId) >>= showGroupsList
toView $ viewGroupMembers group
ListGroups -> withStore (`getUserGroupDetails` userId) >>= toView . viewGroupsList
SendGroupMessage gName msg -> do
-- TODO save pending message delivery for members without connections
Group {members, membership} <- withStore $ \st -> getGroup st user gName
@ -332,7 +314,7 @@ processChatCommand user@User {userId, profile} = \case
SndFileTransfer {fileId} <- withStore $ \st ->
createSndFileTransfer st userId contact f fileInv agentConnId chSize
sendDirectMessage (contactConn contact) $ XFile fileInv
showSentFileInfo fileId
toView $ viewSentFileInfo fileId
setActive $ ActiveC cName
SendGroupFile gName f -> do
(fileSize, chSize) <- checkSndFile f
@ -346,7 +328,7 @@ processChatCommand user@User {userId, profile} = \case
-- TODO sendGroupMessage - same file invitation to all
forM_ ms $ \(m, _, fileInv) ->
traverse (`sendDirectMessage` XFile fileInv) $ memberConn m
showSentFileInfo fileId
toView $ viewSentFileInfo fileId
setActive $ ActiveG gName
ReceiveFile fileId filePath_ -> do
ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileConnReq}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
@ -355,29 +337,29 @@ processChatCommand user@User {userId, profile} = \case
Right agentConnId -> do
filePath <- getRcvFilePath fileId filePath_ fileName
withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
showRcvFileAccepted ft filePath
Left (ChatErrorAgent (SMP SMP.AUTH)) -> showRcvFileSndCancelled ft
Left (ChatErrorAgent (CONN DUPLICATE)) -> showRcvFileSndCancelled ft
toView $ viewRcvFileAccepted ft filePath
Left (ChatErrorAgent (SMP SMP.AUTH)) -> toView $ viewRcvFileSndCancelled ft
Left (ChatErrorAgent (CONN DUPLICATE)) -> toView $ viewRcvFileSndCancelled ft
Left e -> throwError e
CancelFile fileId ->
withStore (\st -> getFileTransfer st userId fileId) >>= \case
FTSnd fts -> do
forM_ fts $ \ft -> cancelSndFileTransfer ft
showSndGroupFileCancelled fts
toView $ viewSndGroupFileCancelled fts
FTRcv ft -> do
cancelRcvFileTransfer ft
showRcvFileCancelled ft
toView $ viewRcvFileCancelled ft
FileStatus fileId ->
withStore (\st -> getFileTransferProgress st userId fileId) >>= showFileTransferStatus
withStore (\st -> getFileTransferProgress st userId fileId) >>= toView . viewFileTransferStatus
UpdateProfile p -> unless (p == profile) $ do
user' <- withStore $ \st -> updateUserProfile st user p
asks currentUser >>= atomically . (`writeTVar` user')
contacts <- withStore (`getUserContacts` user)
forM_ contacts $ \ct -> sendDirectMessage (contactConn ct) $ XInfo p
showUserProfileUpdated user user'
ShowProfile -> showUserProfile profile
toView $ viewUserProfileUpdated user user'
ShowProfile -> toView $ viewUserProfile profile
QuitChat -> liftIO exitSuccess
ShowVersion -> printToView clientVersionInfo
ShowVersion -> toView clientVersionInfo
where
connect :: ConnectionRequestUri c -> ChatMsgEvent -> m ()
connect cReq msg = do
@ -429,19 +411,21 @@ processChatCommand user@User {userId, profile} = \case
f = filePath `combine` (name <> suffix <> ext)
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
agentSubscriber = do
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => ([StyledString] -> m ()) -> m ()
agentSubscriber toView = do
q <- asks $ subQ . smpAgent
l <- asks chatLock
subscribeUserConnections
subscribeUserConnections toView
forever $ do
(_, connId, msg) <- atomically $ readTBQueue q
user <- readTVarIO =<< asks currentUser
withLock l . void . runExceptT $
processAgentMessage user connId msg `catchError` showChatError
processAgentMessage toView' user connId msg `catchError` (toView' . viewChatError)
where
toView' = ExceptT . fmap Right . toView
subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
subscribeUserConnections = void . runExceptT $ do
subscribeUserConnections :: forall m. (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => ([StyledString] -> m ()) -> m ()
subscribeUserConnections toView = void . runExceptT $ do
user <- readTVarIO =<< asks currentUser
subscribeContacts user
subscribeGroups user
@ -449,39 +433,40 @@ subscribeUserConnections = void . runExceptT $ do
subscribePendingConnections user
subscribeUserContactLink user
where
toView' = ExceptT . fmap Right . toView
subscribeContacts user = do
contacts <- withStore (`getUserContacts` user)
forM_ contacts $ \ct@Contact {localDisplayName = c} ->
(subscribe (contactConnId ct) >> showContactSubscribed c) `catchError` showContactSubError c
(subscribe (contactConnId ct) >> toView' (viewContactSubscribed c)) `catchError` (toView' . viewContactSubError c)
subscribeGroups user = do
groups <- withStore (`getUserGroups` user)
forM_ groups $ \g@Group {members, membership, localDisplayName = gn} -> do
let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members
if memberStatus membership == GSMemInvited
then showGroupInvitation g
then toView' $ viewGroupInvitation g
else
if null connectedMembers
then
if memberActive membership
then showGroupEmpty g
else showGroupRemoved g
then toView' $ viewGroupEmpty g
else toView' $ viewGroupRemoved g
else do
forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
subscribe cId `catchError` showMemberSubError gn c
showGroupSubscribed g
subscribe cId `catchError` (toView' . viewMemberSubError gn c)
toView' $ viewGroupSubscribed g
subscribeFiles user = do
withStore (`getLiveSndFileTransfers` user) >>= mapM_ subscribeSndFile
withStore (`getLiveRcvFileTransfers` user) >>= mapM_ subscribeRcvFile
where
subscribeSndFile ft@SndFileTransfer {fileId, fileStatus, agentConnId} = do
subscribe agentConnId `catchError` showSndFileSubError ft
subscribe agentConnId `catchError` (toView' . viewSndFileSubError ft)
void . forkIO $ do
threadDelay 1000000
l <- asks chatLock
a <- asks smpAgent
unless (fileStatus == FSNew) . unlessM (isFileActive fileId sndFiles) $
withAgentLock a . withLock l $
sendFileChunk ft
sendFileChunk toView' ft
subscribeRcvFile ft@RcvFileTransfer {fileStatus} =
case fileStatus of
RFSAccepted fInfo -> resume fInfo
@ -489,22 +474,22 @@ subscribeUserConnections = void . runExceptT $ do
_ -> pure ()
where
resume RcvFileInfo {agentConnId} =
subscribe agentConnId `catchError` showRcvFileSubError ft
subscribe agentConnId `catchError` (toView' . viewRcvFileSubError ft)
subscribePendingConnections user = do
cs <- withStore (`getPendingConnections` user)
subscribeConns cs `catchError` \_ -> pure ()
subscribeUserContactLink User {userId} = do
cs <- withStore (`getUserContactLinkConnections` userId)
(subscribeConns cs >> showUserContactLinkSubscribed)
`catchError` showUserContactLinkSubError
(subscribeConns cs >> toView' viewUserContactLinkSubscribed)
`catchError` (toView' . viewUserContactLinkSubError)
subscribe cId = withAgent (`subscribeConnection` cId)
subscribeConns conns =
withAgent $ \a ->
forM_ conns $ \Connection {agentConnId} ->
subscribeConnection a agentConnId
processAgentMessage :: forall m. ChatMonad m => User -> ConnId -> ACommand 'Agent -> m ()
processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
processAgentMessage :: forall m. ChatMonad m => ([StyledString] -> m ()) -> User -> ConnId -> ACommand 'Agent -> m ()
processAgentMessage toView user@User {userId, profile} agentConnId agentMessage = do
chatDirection <- withStore $ \st -> getConnectionChatDirection st user agentConnId
forM_ (agentMsgConnStatus agentMessage) $ \status ->
withStore $ \st -> updateConnectionStatus st (fromConnection chatDirection) status
@ -594,7 +579,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
CON ->
withStore (\st -> getViaGroupMember st user ct) >>= \case
Nothing -> do
showContactConnected ct
toView $ viewContactConnected ct
setActive $ ActiveC c
showToast (c <> "> ") "connected"
Just (gName, m) ->
@ -604,14 +589,14 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
SENT msgId ->
sentMsgDeliveryEvent conn msgId
END -> do
showContactAnotherClient c
toView $ viewContactAnotherClient c
showToast (c <> "> ") "connected to another client"
unsetActive $ ActiveC c
DOWN -> do
showContactDisconnected c
toView $ viewContactDisconnected c
showToast (c <> "> ") "disconnected"
UP -> do
showContactSubscribed c
toView $ viewContactSubscribed c
showToast (c <> "> ") "is active"
setActive $ ActiveC c
-- TODO print errors
@ -662,11 +647,11 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
-- TODO forward any pending (GMIntroInvReceived) introductions
case memberCategory m of
GCHostMember -> do
showUserJoinedGroup gName
toView $ viewUserJoinedGroup gName
setActive $ ActiveG gName
showToast ("#" <> gName) "you are connected to group"
GCInviteeMember -> do
showJoinedGroupMember gName m
toView $ viewJoinedGroupMember gName m
setActive $ ActiveG gName
showToast ("#" <> gName) $ "member " <> localDisplayName (m :: GroupMember) <> " is connected"
intros <- withStore $ \st -> createIntroductions st group m
@ -723,15 +708,15 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
_ -> messageError "CONF from file connection must have x.file.acpt"
CON -> do
withStore $ \st -> updateSndFileStatus st ft FSConnected
showSndFileStart ft
sendFileChunk ft
toView $ viewSndFileStart ft
sendFileChunk toView ft
SENT msgId -> do
withStore $ \st -> updateSndFileChunkSent st ft msgId
unless (fileStatus == FSCancelled) $ sendFileChunk ft
unless (fileStatus == FSCancelled) $ sendFileChunk toView ft
MERR _ err -> do
cancelSndFileTransfer ft
case err of
SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ showSndFileRcvCancelled ft
SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ toView $ viewSndFileRcvCancelled ft
_ -> chatError $ CEFileSend fileId err
MSG meta _ ->
withAckMessage agentConnId meta $ pure ()
@ -745,12 +730,12 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
case agentMsg of
CON -> do
withStore $ \st -> updateRcvFileStatus st ft FSConnected
showRcvFileStart ft
toView $ viewRcvFileStart ft
MSG meta@MsgMeta {recipient = (msgId, _), integrity} msgBody -> withAckMessage agentConnId meta $ do
parseFileChunk msgBody >>= \case
FileChunkCancel -> do
cancelRcvFileTransfer ft
showRcvFileSndCancelled ft
toView $ viewRcvFileSndCancelled ft
FileChunk {chunkNo, chunkBytes = chunk} -> do
case integrity of
MsgOk -> pure ()
@ -770,7 +755,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
withStore $ \st -> do
updateRcvFileStatus st ft FSComplete
deleteRcvFileChunks st ft
showRcvFileComplete ft
toView $ viewRcvFileComplete ft
closeFileHandle fileId rcvFiles
withAgent (`deleteConnection` agentConnId)
RcvChunkDuplicate -> pure ()
@ -799,7 +784,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
profileContactRequest :: InvitationId -> Profile -> m ()
profileContactRequest invId p = do
cName <- withStore $ \st -> createContactRequest st userId userContactLinkId invId p
showReceivedContactRequest cName p
toView $ viewReceivedContactRequest cName p
showToast (cName <> "> ") "wants to connect to you"
withAckMessage :: ConnId -> MsgMeta -> m () -> m ()
@ -824,7 +809,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
notifyMemberConnected :: GroupName -> GroupMember -> m ()
notifyMemberConnected gName m@GroupMember {localDisplayName} = do
showConnectedToGroupMember gName m
toView $ viewConnectedToGroupMember gName m
setActive $ ActiveG gName
showToast ("#" <> gName) $ "member " <> localDisplayName <> " is connected"
@ -842,20 +827,20 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
withStore $ \st -> createSentProbeHash st userId probeId c
messageWarning :: Text -> m ()
messageWarning = showMessageError "warning"
messageWarning = toView . viewMessageError "warning"
messageError :: Text -> m ()
messageError = showMessageError "error"
messageError = toView . viewMessageError "error"
newTextMessage :: ContactName -> MsgMeta -> Text -> m ()
newTextMessage c meta text = do
showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
toView =<< liftIO (viewReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta)))
showToast (c <> "> ") text
setActive $ ActiveC c
newGroupTextMessage :: GroupName -> GroupMember -> MsgMeta -> Text -> m ()
newGroupTextMessage gName GroupMember {localDisplayName = c} meta text = do
showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
toView =<< liftIO (viewReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta)))
showToast ("#" <> gName <> " " <> c <> "> ") text
setActive $ ActiveG gName
@ -864,7 +849,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
-- TODO chunk size has to be sent as part of invitation
chSize <- asks $ fileChunkSize . config
ft <- withStore $ \st -> createRcvFileTransfer st userId contact fInv chSize
showReceivedMessage c (snd $ broker meta) (receivedFileInvitation ft) (integrity (meta :: MsgMeta))
toView =<< liftIO (viewReceivedFileInvitation c (snd $ broker meta) ft (integrity (meta :: MsgMeta)))
showToast (c <> "> ") "wants to send a file"
setActive $ ActiveC c
@ -872,7 +857,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
processGroupFileInvitation gName m@GroupMember {localDisplayName = c} meta fInv = do
chSize <- asks $ fileChunkSize . config
ft <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
showReceivedGroupMessage gName c (snd $ broker meta) (receivedFileInvitation ft) (integrity (meta :: MsgMeta))
toView =<< liftIO (viewReceivedGroupFileInvitation gName c (snd $ broker meta) ft (integrity (meta :: MsgMeta)))
showToast ("#" <> gName <> " " <> c <> "> ") "wants to send a file"
setActive $ ActiveG gName
@ -881,13 +866,13 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
when (fromRole < GRAdmin || fromRole < memRole) $ chatError (CEGroupContactRole c)
when (fromMemId == memId) $ chatError CEGroupDuplicateMemberId
group@Group {localDisplayName = gName} <- withStore $ \st -> createGroupInvitation st user ct inv
showReceivedGroupInvitation group c memRole
toView $ viewReceivedGroupInvitation group c memRole
showToast ("#" <> gName <> " " <> c <> "> ") $ "invited you to join the group"
xInfo :: Contact -> Profile -> m ()
xInfo c@Contact {profile = p} p' = unless (p == p') $ do
c' <- withStore $ \st -> updateContactProfile st userId c p'
showContactUpdated c c'
toView $ viewContactUpdated c c'
xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe = do
@ -913,7 +898,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
mergeContacts :: Contact -> Contact -> m ()
mergeContacts to from = do
withStore $ \st -> mergeContactRecords st userId to from
showContactsMerged to from
toView $ viewContactsMerged to from
saveConnInfo :: Connection -> ConnInfo -> m ()
saveConnInfo activeConn connInfo = do
@ -932,7 +917,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
then messageError "x.grp.mem.new error: member already exists"
else do
newMember <- withStore $ \st -> createNewGroupMember st user group memInfo GCPostMember GSMemAnnounced
showJoinedGroupMemberConnecting gName m newMember
toView $ viewJoinedGroupMemberConnecting gName m newMember
xGrpMemIntro :: Connection -> GroupName -> GroupMember -> MemberInfo -> m ()
xGrpMemIntro conn gName m memInfo@(MemberInfo memId _ _) =
@ -989,7 +974,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
then do
mapM_ deleteMemberConnection members
withStore $ \st -> updateGroupMemberStatus st userId membership GSMemRemoved
showDeletedMemberUser gName m
toView $ viewDeletedMemberUser gName m
else case find (sameMemberId memId) members of
Nothing -> messageError "x.grp.mem.del with unknown member ID"
Just member -> do
@ -999,7 +984,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
else do
deleteMemberConnection member
withStore $ \st -> updateGroupMemberStatus st userId member GSMemRemoved
showDeletedMember gName (Just m) (Just member)
toView $ viewDeletedMember gName (Just m) (Just member)
sameMemberId :: MemberId -> GroupMember -> Bool
sameMemberId memId GroupMember {memberId} = memId == memberId
@ -1008,7 +993,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
xGrpLeave gName m = do
deleteMemberConnection m
withStore $ \st -> updateGroupMemberStatus st userId m GSMemLeft
showLeftMember gName m
toView $ viewLeftMember gName m
xGrpDel :: GroupName -> GroupMember -> m ()
xGrpDel gName m@GroupMember {memberRole} = do
@ -1018,13 +1003,13 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
updateGroupMemberStatus st userId membership GSMemGroupDeleted
pure members
mapM_ deleteMemberConnection ms
showGroupDeleted gName m
toView $ viewGroupDeleted gName m
parseChatMessage :: ByteString -> Either ChatError ChatMessage
parseChatMessage = first ChatErrorMessage . strDecode
sendFileChunk :: ChatMonad m => SndFileTransfer -> m ()
sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
sendFileChunk :: ChatMonad m => ([StyledString] -> m ()) -> SndFileTransfer -> m ()
sendFileChunk toView ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
unless (fileStatus == FSComplete || fileStatus == FSCancelled) $
withStore (`createSndFileChunk` ft) >>= \case
Just chunkNo -> sendFileChunkNo ft chunkNo
@ -1032,7 +1017,7 @@ sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
withStore $ \st -> do
updateSndFileStatus st ft FSComplete
deleteSndFileChunks st ft
showSndFileComplete ft
toView $ viewSndFileComplete ft
closeFileHandle fileId sndFiles
withAgent (`deleteConnection` agentConnId)

14
src/Simplex/Chat/Controller.hs
View file

@ -2,6 +2,7 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Controller where
@ -14,9 +15,8 @@ import Crypto.Random (ChaChaDRG)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import Numeric.Natural
import Simplex.Chat.Notification
import Simplex.Chat.Store (StoreError)
import Simplex.Chat.Terminal
import Simplex.Chat.Styled
import Simplex.Chat.Types
import Simplex.Messaging.Agent (AgentClient)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig)
@ -41,14 +41,18 @@ data ChatConfig = ChatConfig
fileChunkSize :: Integer
}
data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName
deriving (Eq)
data ChatController = ChatController
{ currentUser :: TVar User,
activeTo :: TVar ActiveTo,
firstTime :: Bool,
smpAgent :: AgentClient,
chatTerminal :: ChatTerminal,
chatStore :: SQLiteStore,
idsDrg :: TVar ChaChaDRG,
inputQ :: TBQueue InputEvent,
outputQ :: TBQueue [StyledString],
notifyQ :: TBQueue Notification,
sendNotification :: Notification -> IO (),
chatLock :: TMVar (),
@ -90,9 +94,9 @@ data ChatErrorType
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m, MonadFail m)
setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
setActive to = asks (activeTo . chatTerminal) >>= atomically . (`writeTVar` to)
setActive to = asks activeTo >>= atomically . (`writeTVar` to)
unsetActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
unsetActive a = asks (activeTo . chatTerminal) >>= atomically . (`modifyTVar` unset)
unsetActive a = asks activeTo >>= atomically . (`modifyTVar` unset)
where
unset a' = if a == a' then ActiveNone else a'

11
migrations/20220101_initial.sql → src/Simplex/Chat/Migrations/M20220101_initial.hs
View file

@ -1,3 +1,13 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220101_initial where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20220101_initial :: Query
m20220101_initial =
[sql|
CREATE TABLE contact_profiles ( -- remote user profile
contact_profile_id INTEGER PRIMARY KEY,
display_name TEXT NOT NULL, -- contact name set by remote user (not unique), this name must not contain spaces
@ -257,3 +267,4 @@ CREATE TABLE msg_delivery_events (
created_at TEXT NOT NULL DEFAULT (datetime('now')),
UNIQUE (msg_delivery_id, delivery_status)
);
|]

126
src/Simplex/Chat/Mobile.hs Normal file
View file

@ -0,0 +1,126 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Mobile where
import Control.Concurrent (forkIO)
import Control.Concurrent.STM
import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson ((.=))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.List (find)
import Foreign.C.String
import Foreign.StablePtr
import Simplex.Chat
import Simplex.Chat.Controller
import Simplex.Chat.Options
import Simplex.Chat.Store
import Simplex.Chat.Styled
import Simplex.Chat.Types
foreign export ccall "chat_init_store" cChatInitStore :: CString -> IO (StablePtr ChatStore)
foreign export ccall "chat_get_user" cChatGetUser :: StablePtr ChatStore -> IO CJSONString
foreign export ccall "chat_create_user" cChatCreateUser :: StablePtr ChatStore -> CJSONString -> IO CJSONString
foreign export ccall "chat_start" cChatStart :: StablePtr ChatStore -> IO (StablePtr ChatController)
foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CString
-- | creates or connects to chat store
cChatInitStore :: CString -> IO (StablePtr ChatStore)
cChatInitStore fp = peekCString fp >>= chatInitStore >>= newStablePtr
-- | returns JSON in the form `{"user": <user object>}` or `{}` in case there is no active user (to show dialog to enter displayName/fullName)
cChatGetUser :: StablePtr ChatStore -> IO CJSONString
cChatGetUser cc = deRefStablePtr cc >>= chatGetUser >>= newCString
-- | accepts Profile JSON, returns JSON `{"user": <user object>}` or `{"error": "<error>"}`
cChatCreateUser :: StablePtr ChatStore -> CJSONString -> IO CJSONString
cChatCreateUser cPtr profileCJson = do
c <- deRefStablePtr cPtr
p <- peekCString profileCJson
newCString =<< chatCreateUser c p
-- | this function starts chat - it cannot be started during initialization right now, as it cannot work without user (to be fixed later)
cChatStart :: StablePtr ChatStore -> IO (StablePtr ChatController)
cChatStart st = deRefStablePtr st >>= chatStart >>= newStablePtr
-- | send command to chat (same syntax as in terminal for now)
cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
cChatSendCmd cPtr cCmd = do
c <- deRefStablePtr cPtr
cmd <- peekCString cCmd
newCString =<< chatSendCmd c cmd
-- | receive message from chat (blocking)
cChatRecvMsg :: StablePtr ChatController -> IO CString
cChatRecvMsg cc = deRefStablePtr cc >>= chatRecvMsg >>= newCString
mobileChatOpts :: ChatOpts
mobileChatOpts =
ChatOpts
{ dbFilePrefix = "simplex_v1", -- two database files will be created: simplex_v1_chat.db and simplex_v1_agent.db
smpServers = defaultSMPServers,
logging = False
}
type CJSONString = CString
type JSONString = String
data ChatStore = ChatStore
{ dbFilePrefix :: FilePath,
chatStore :: SQLiteStore
}
chatInitStore :: String -> IO ChatStore
chatInitStore dbFilePrefix = do
let f = chatStoreFile dbFilePrefix
chatStore <- createStore f $ dbPoolSize defaultChatConfig
pure ChatStore {dbFilePrefix, chatStore}
getActiveUser_ :: SQLiteStore -> IO (Maybe User)
getActiveUser_ st = find activeUser <$> getUsers st
-- | returns JSON in the form `{"user": <user object>}` or `{}`
chatGetUser :: ChatStore -> IO JSONString
chatGetUser ChatStore {chatStore} =
maybe "{}" (jsonObject . ("user" .=)) <$> getActiveUser_ chatStore
-- | returns JSON in the form `{"user": <user object>}` or `{"error": "<error>"}`
chatCreateUser :: ChatStore -> JSONString -> IO JSONString
chatCreateUser ChatStore {chatStore} profileJson =
case J.eitherDecodeStrict' $ B.pack profileJson of
Left e -> err e
Right p ->
runExceptT (createUser chatStore p True) >>= \case
Right user -> pure . jsonObject $ "user" .= user
Left e -> err e
where
err e = pure . jsonObject $ "error" .= show e
chatStart :: ChatStore -> IO ChatController
chatStart ChatStore {dbFilePrefix, chatStore} = do
Just user <- getActiveUser_ chatStore
cc <- newChatController chatStore user defaultChatConfig mobileChatOpts {dbFilePrefix} . const $ pure ()
void . forkIO $ runReaderT runChatController cc
pure cc
chatSendCmd :: ChatController -> String -> IO JSONString
chatSendCmd ChatController {inputQ} s = atomically (writeTBQueue inputQ $ InputCommand s) >> pure "{}"
chatRecvMsg :: ChatController -> IO String
chatRecvMsg ChatController {outputQ} = unlines . map unStyle <$> atomically (readTBQueue outputQ)
jsonObject :: J.Series -> JSONString
jsonObject = LB.unpack . JE.encodingToLazyByteString . J.pairs

26
src/Simplex/Chat/Options.hs
View file

@ -1,6 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Options (getChatOpts, ChatOpts (..)) where
module Simplex.Chat.Options
( ChatOpts (..),
getChatOpts,
defaultSMPServers,
)
where
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
@ -14,11 +19,20 @@ import Simplex.Messaging.Parsers (parseAll)
import System.FilePath (combine)
data ChatOpts = ChatOpts
{ dbFile :: String,
{ dbFilePrefix :: String,
smpServers :: NonEmpty SMPServer,
logging :: Bool
}
defaultSMPServers :: NonEmpty SMPServer
defaultSMPServers =
L.fromList
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im",
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im",
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im"
-- "smp://Tn1b3Rr7_gErbVt2v50Y_T-PvUAi1BYAMS-62w-k9CI=@139.162.240.237"
]
chatOpts :: FilePath -> Parser ChatOpts
chatOpts appDir =
ChatOpts
@ -38,13 +52,7 @@ chatOpts appDir =
<> help
"Comma separated list of SMP server(s) to use \
\(default: smp4.simplex.im,smp5.simplex.im,smp6.simplex.im)"
<> value
( L.fromList
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im",
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im",
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im"
]
)
<> value defaultSMPServers
)
<*> switch
( long "log"

19
src/Simplex/Chat/Store.hs
View file

@ -108,7 +108,6 @@ import Crypto.Random (ChaChaDRG, randomBytesGenerate)
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import Data.Either (rights)
import Data.FileEmbed (embedDir, makeRelativeToProject)
import Data.Function (on)
import Data.Functor (($>))
import Data.Int (Int64)
@ -116,11 +115,11 @@ import Data.List (find, sortBy)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Clock (UTCTime, getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), SQLError, (:.) (..))
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..))
import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Migrations.M20220101_initial
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@ -128,17 +127,19 @@ import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Util (bshow, liftIOEither, (<$$>))
import System.FilePath (takeBaseName, takeExtension, takeFileName)
import System.FilePath (takeFileName)
import UnliftIO.STM
schemaMigrations :: [(String, Query)]
schemaMigrations =
[ ("20220101_initial", m20220101_initial)
]
-- | The list of migrations in ascending order by date
migrations :: [Migration]
migrations =
sortBy (compare `on` name) . map migration . filter sqlFile $
$(makeRelativeToProject "migrations" >>= embedDir)
migrations = sortBy (compare `on` name) $ map migration schemaMigrations
where
sqlFile (file, _) = takeExtension file == ".sql"
migration (file, qStr) = Migration {name = takeBaseName file, up = decodeUtf8 qStr}
migration (name, query) = Migration {name = name, up = fromQuery query}
createStore :: FilePath -> Int -> IO SQLiteStore
createStore dbFilePath poolSize = createSQLiteStore dbFilePath poolSize migrations

5
src/Simplex/Chat/Styled.hs
View file

@ -6,6 +6,7 @@ module Simplex.Chat.Styled
StyledFormat (..),
styleMarkdown,
styleMarkdownText,
unStyle,
sLength,
sShow,
)
@ -69,6 +70,10 @@ sgr = \case
Snippet -> []
NoFormat -> []
unStyle :: StyledString -> String
unStyle (Styled _ s) = s
unStyle (s1 :<>: s2) = unStyle s1 <> unStyle s2
sLength :: StyledString -> Int
sLength (Styled _ s) = length s
sLength (s1 :<>: s2) = sLength s1 + sLength s2

200
src/Simplex/Chat/Terminal.hs
View file

@ -1,176 +1,38 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Chat.Terminal where
import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Class (MonadIO)
import Simplex.Chat.Styled
import Simplex.Chat.Types
import System.Console.ANSI.Types
import System.Terminal
import System.Terminal.Internal (LocalTerminal, Terminal, VirtualTerminal)
import UnliftIO.STM
import Control.Logger.Simple
import Control.Monad.Reader
import Simplex.Chat
import Simplex.Chat.Controller
import Simplex.Chat.Help (chatWelcome)
import Simplex.Chat.Options
import Simplex.Chat.Store
import Simplex.Chat.Terminal.Input
import Simplex.Chat.Terminal.Notification
import Simplex.Chat.Terminal.Output
import Simplex.Chat.Types (User)
import Simplex.Chat.Util (whenM)
import Simplex.Messaging.Util (raceAny_)
data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName
deriving (Eq)
data ChatTerminal = ChatTerminal
{ activeTo :: TVar ActiveTo,
termDevice :: TerminalDevice,
termState :: TVar TerminalState,
termSize :: Size,
nextMessageRow :: TVar Int,
termLock :: TMVar ()
}
data TerminalState = TerminalState
{ inputPrompt :: String,
inputString :: String,
inputPosition :: Int,
previousInput :: String
}
class Terminal t => WithTerminal t where
withTerm :: (MonadIO m, MonadMask m) => t -> (t -> m a) -> m a
data TerminalDevice = forall t. WithTerminal t => TerminalDevice t
instance WithTerminal LocalTerminal where
withTerm _ = withTerminal
instance WithTerminal VirtualTerminal where
withTerm t = ($ t)
withChatTerm :: (MonadIO m, MonadMask m) => ChatTerminal -> (forall t. WithTerminal t => TerminalT t m a) -> m a
withChatTerm ChatTerminal {termDevice = TerminalDevice t} action = withTerm t $ runTerminalT action
newChatTerminal :: WithTerminal t => t -> IO ChatTerminal
newChatTerminal t = do
activeTo <- newTVarIO ActiveNone
termSize <- withTerm t . runTerminalT $ getWindowSize
let lastRow = height termSize - 1
termState <- newTVarIO newTermState
termLock <- newTMVarIO ()
nextMessageRow <- newTVarIO lastRow
-- threadDelay 500000 -- this delay is the same as timeout in getTerminalSize
return ChatTerminal {activeTo, termDevice = TerminalDevice t, termState, termSize, nextMessageRow, termLock}
newTermState :: TerminalState
newTermState =
TerminalState
{ inputString = "",
inputPosition = 0,
inputPrompt = "> ",
previousInput = ""
}
withTermLock :: MonadTerminal m => ChatTerminal -> m () -> m ()
withTermLock ChatTerminal {termLock} action = do
_ <- atomically $ takeTMVar termLock
action
atomically $ putTMVar termLock ()
printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
printToTerminal ct s =
withChatTerm ct $
withTermLock ct $ do
printMessage ct s
updateInput ct
updateInput :: forall m. MonadTerminal m => ChatTerminal -> m ()
updateInput ChatTerminal {termSize = Size {height, width}, termState, nextMessageRow} = do
hideCursor
ts <- readTVarIO termState
nmr <- readTVarIO nextMessageRow
let ih = inputHeight ts
iStart = height - ih
prompt = inputPrompt ts
Position {row, col} = positionRowColumn width $ length prompt + inputPosition ts
if nmr >= iStart
then atomically $ writeTVar nextMessageRow iStart
else clearLines nmr iStart
setCursorPosition $ Position {row = max nmr iStart, col = 0}
putString $ prompt <> inputString ts <> " "
eraseInLine EraseForward
setCursorPosition $ Position {row = iStart + row, col}
showCursor
flush
simplexChat :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChat cfg opts t
| logging opts = do
setLogLevel LogInfo -- LogError
withGlobalLogging logCfg initRun
| otherwise = initRun
where
clearLines :: Int -> Int -> m ()
clearLines from till
| from >= till = return ()
| otherwise = do
setCursorPosition $ Position {row = from, col = 0}
eraseInLine EraseForward
clearLines (from + 1) till
inputHeight :: TerminalState -> Int
inputHeight ts = length (inputPrompt ts <> inputString ts) `div` width + 1
positionRowColumn :: Int -> Int -> Position
positionRowColumn wid pos =
let row = pos `div` wid
col = pos - row * wid
in Position {row, col}
initRun = do
sendNotification <- initializeNotifications
let f = chatStoreFile $ dbFilePrefix opts
st <- createStore f $ dbPoolSize cfg
user <- getCreateActiveUser st
ct <- newChatTerminal t
cc <- newChatController st user cfg opts sendNotification
runSimplexChat user ct cc
printMessage :: forall m. MonadTerminal m => ChatTerminal -> [StyledString] -> m ()
printMessage ChatTerminal {termSize = Size {height, width}, nextMessageRow} msg = do
nmr <- readTVarIO nextMessageRow
setCursorPosition $ Position {row = nmr, col = 0}
mapM_ printStyled msg
flush
let lc = sum $ map lineCount msg
atomically . writeTVar nextMessageRow $ min (height - 1) (nmr + lc)
where
lineCount :: StyledString -> Int
lineCount s = sLength s `div` width + 1
printStyled :: StyledString -> m ()
printStyled s = do
putStyled s
eraseInLine EraseForward
putLn
-- Currently it is assumed that the message does not have internal line breaks.
-- Previous implementation "kind of" supported them,
-- but it was not determining the number of printed lines correctly
-- because of accounting for control sequences in length
putStyled :: MonadTerminal m => StyledString -> m ()
putStyled (s1 :<>: s2) = putStyled s1 >> putStyled s2
putStyled (Styled [] s) = putString s
putStyled (Styled sgr s) = setSGR sgr >> putString s >> resetAttributes
setSGR :: MonadTerminal m => [SGR] -> m ()
setSGR = mapM_ $ \case
Reset -> resetAttributes
SetConsoleIntensity BoldIntensity -> setAttribute bold
SetConsoleIntensity _ -> resetAttribute bold
SetItalicized True -> setAttribute italic
SetItalicized _ -> resetAttribute italic
SetUnderlining NoUnderline -> resetAttribute underlined
SetUnderlining _ -> setAttribute underlined
SetSwapForegroundBackground True -> setAttribute inverted
SetSwapForegroundBackground _ -> resetAttribute inverted
SetColor l i c -> setAttribute . layer l . intensity i $ color c
SetBlinkSpeed _ -> pure ()
SetVisible _ -> pure ()
SetRGBColor _ _ -> pure ()
SetPaletteColor _ _ -> pure ()
SetDefaultColor _ -> pure ()
where
layer = \case
Foreground -> foreground
Background -> background
intensity = \case
Dull -> id
Vivid -> bright
color = \case
Black -> black
Red -> red
Green -> green
Yellow -> yellow
Blue -> blue
Magenta -> magenta
Cyan -> cyan
White -> white
runSimplexChat :: User -> ChatTerminal -> ChatController -> IO ()
runSimplexChat user ct = runReaderT $ do
whenM (asks firstTime) . liftIO . printToTerminal ct $ chatWelcome user
raceAny_ [runTerminalInput ct, runTerminalOutput ct, runChatController]

16
src/Simplex/Chat/Input.hs → src/Simplex/Chat/Terminal/Input.hs
View file

@ -2,14 +2,14 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
module Simplex.Chat.Input where
module Simplex.Chat.Terminal.Input where
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.List (dropWhileEnd)
import qualified Data.Text as T
import Simplex.Chat.Controller
import Simplex.Chat.Terminal
import Simplex.Chat.Terminal.Output
import System.Exit (exitSuccess)
import System.Terminal hiding (insertChars)
import UnliftIO.STM
@ -21,16 +21,16 @@ getKey =
Right (KeyEvent key ms) -> pure (key, ms)
_ -> getKey
runTerminalInput :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
runTerminalInput = do
ChatController {inputQ, chatTerminal = ct} <- ask
runTerminalInput :: (MonadUnliftIO m, MonadReader ChatController m) => ChatTerminal -> m ()
runTerminalInput ct = do
cc <- ask
liftIO $
withChatTerm ct $ do
updateInput ct
receiveFromTTY inputQ ct
receiveFromTTY cc ct
receiveFromTTY :: MonadTerminal m => TBQueue InputEvent -> ChatTerminal -> m ()
receiveFromTTY inputQ ct@ChatTerminal {activeTo, termSize, termState} =
receiveFromTTY :: MonadTerminal m => ChatController -> ChatTerminal -> m ()
receiveFromTTY ChatController {inputQ, activeTo} ct@ChatTerminal {termSize, termState} =
forever $ getKey >>= processKey >> withTermLock ct (updateInput ct)
where
processKey :: MonadTerminal m => (Key, Modifiers) -> m ()

5
src/Simplex/Chat/Notification.hs → src/Simplex/Chat/Terminal/Notification.hs
View file

@ -3,7 +3,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Chat.Notification (Notification (..), initializeNotifications) where
module Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications) where
import Control.Exception
import Control.Monad (void)
@ -13,13 +13,12 @@ import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Simplex.Chat.Types
import System.Directory (createDirectoryIfMissing, doesFileExist, findExecutable, getAppUserDataDirectory)
import System.FilePath (combine)
import System.Info (os)
import System.Process (readCreateProcess, shell)
data Notification = Notification {title :: Text, text :: Text}
initializeNotifications :: IO (Notification -> IO ())
initializeNotifications =
hideException <$> case os of

179
src/Simplex/Chat/Terminal/Output.hs Normal file
View file

@ -0,0 +1,179 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Chat.Terminal.Output where
import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Simplex.Chat.Controller
import Simplex.Chat.Styled
import System.Console.ANSI.Types
import System.Terminal
import System.Terminal.Internal (LocalTerminal, Terminal, VirtualTerminal)
import UnliftIO.STM
data ChatTerminal = ChatTerminal
{ termDevice :: TerminalDevice,
termState :: TVar TerminalState,
termSize :: Size,
nextMessageRow :: TVar Int,
termLock :: TMVar ()
}
data TerminalState = TerminalState
{ inputPrompt :: String,
inputString :: String,
inputPosition :: Int,
previousInput :: String
}
class Terminal t => WithTerminal t where
withTerm :: (MonadIO m, MonadMask m) => t -> (t -> m a) -> m a
data TerminalDevice = forall t. WithTerminal t => TerminalDevice t
instance WithTerminal LocalTerminal where
withTerm _ = withTerminal
instance WithTerminal VirtualTerminal where
withTerm t = ($ t)
withChatTerm :: (MonadIO m, MonadMask m) => ChatTerminal -> (forall t. WithTerminal t => TerminalT t m a) -> m a
withChatTerm ChatTerminal {termDevice = TerminalDevice t} action = withTerm t $ runTerminalT action
newChatTerminal :: WithTerminal t => t -> IO ChatTerminal
newChatTerminal t = do
termSize <- withTerm t . runTerminalT $ getWindowSize
let lastRow = height termSize - 1
termState <- newTVarIO mkTermState
termLock <- newTMVarIO ()
nextMessageRow <- newTVarIO lastRow
-- threadDelay 500000 -- this delay is the same as timeout in getTerminalSize
return ChatTerminal {termDevice = TerminalDevice t, termState, termSize, nextMessageRow, termLock}
mkTermState :: TerminalState
mkTermState =
TerminalState
{ inputString = "",
inputPosition = 0,
inputPrompt = "> ",
previousInput = ""
}
withTermLock :: MonadTerminal m => ChatTerminal -> m () -> m ()
withTermLock ChatTerminal {termLock} action = do
_ <- atomically $ takeTMVar termLock
action
atomically $ putTMVar termLock ()
runTerminalOutput :: (MonadUnliftIO m, MonadReader ChatController m) => ChatTerminal -> m ()
runTerminalOutput ct = do
ChatController {outputQ} <- ask
forever $
atomically (readTBQueue outputQ) >>= liftIO . printToTerminal ct
printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
printToTerminal ct s =
withChatTerm ct $
withTermLock ct $ do
printMessage ct s
updateInput ct
updateInput :: forall m. MonadTerminal m => ChatTerminal -> m ()
updateInput ChatTerminal {termSize = Size {height, width}, termState, nextMessageRow} = do
hideCursor
ts <- readTVarIO termState
nmr <- readTVarIO nextMessageRow
let ih = inputHeight ts
iStart = height - ih
prompt = inputPrompt ts
Position {row, col} = positionRowColumn width $ length prompt + inputPosition ts
if nmr >= iStart
then atomically $ writeTVar nextMessageRow iStart
else clearLines nmr iStart
setCursorPosition $ Position {row = max nmr iStart, col = 0}
putString $ prompt <> inputString ts <> " "
eraseInLine EraseForward
setCursorPosition $ Position {row = iStart + row, col}
showCursor
flush
where
clearLines :: Int -> Int -> m ()
clearLines from till
| from >= till = return ()
| otherwise = do
setCursorPosition $ Position {row = from, col = 0}
eraseInLine EraseForward
clearLines (from + 1) till
inputHeight :: TerminalState -> Int
inputHeight ts = length (inputPrompt ts <> inputString ts) `div` width + 1
positionRowColumn :: Int -> Int -> Position
positionRowColumn wid pos =
let row = pos `div` wid
col = pos - row * wid
in Position {row, col}
printMessage :: forall m. MonadTerminal m => ChatTerminal -> [StyledString] -> m ()
printMessage ChatTerminal {termSize = Size {height, width}, nextMessageRow} msg = do
nmr <- readTVarIO nextMessageRow
setCursorPosition $ Position {row = nmr, col = 0}
mapM_ printStyled msg
flush
let lc = sum $ map lineCount msg
atomically . writeTVar nextMessageRow $ min (height - 1) (nmr + lc)
where
lineCount :: StyledString -> Int
lineCount s = sLength s `div` width + 1
printStyled :: StyledString -> m ()
printStyled s = do
putStyled s
eraseInLine EraseForward
putLn
-- Currently it is assumed that the message does not have internal line breaks.
-- Previous implementation "kind of" supported them,
-- but it was not determining the number of printed lines correctly
-- because of accounting for control sequences in length
putStyled :: MonadTerminal m => StyledString -> m ()
putStyled (s1 :<>: s2) = putStyled s1 >> putStyled s2
putStyled (Styled [] s) = putString s
putStyled (Styled sgr s) = setSGR sgr >> putString s >> resetAttributes
setSGR :: MonadTerminal m => [SGR] -> m ()
setSGR = mapM_ $ \case
Reset -> resetAttributes
SetConsoleIntensity BoldIntensity -> setAttribute bold
SetConsoleIntensity _ -> resetAttribute bold
SetItalicized True -> setAttribute italic
SetItalicized _ -> resetAttribute italic
SetUnderlining NoUnderline -> resetAttribute underlined
SetUnderlining _ -> setAttribute underlined
SetSwapForegroundBackground True -> setAttribute inverted
SetSwapForegroundBackground _ -> resetAttribute inverted
SetColor l i c -> setAttribute . layer l . intensity i $ color c
SetBlinkSpeed _ -> pure ()
SetVisible _ -> pure ()
SetRGBColor _ _ -> pure ()
SetPaletteColor _ _ -> pure ()
SetDefaultColor _ -> pure ()
where
layer = \case
Foreground -> foreground
Background -> background
intensity = \case
Dull -> id
Vivid -> bright
color = \case
Black -> black
Red -> red
Green -> green
Yellow -> yellow
Blue -> blue
Magenta -> magenta
Cyan -> cyan
White -> white

5
src/Simplex/Chat/Types.hs
View file

@ -60,6 +60,9 @@ data User = User
profile :: Profile,
activeUser :: Bool
}
deriving (Generic, FromJSON)
instance ToJSON User where toEncoding = J.genericToEncoding J.defaultOptions
type UserId = Int64
@ -743,3 +746,5 @@ msgDeliveryStatusT' s =
case testEquality d (msgDirection @d) of
Just Refl -> Just st
_ -> Nothing
data Notification = Notification {title :: Text, text :: Text}

656
src/Simplex/Chat/View.hs
View file

@ -7,85 +7,83 @@
{-# 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,
( safeDecodeUtf8,
msgPlain,
clientVersionInfo,
viewConnReqInvitation,
viewSentConfirmation,
viewSentInvitation,
viewInvalidConnReq,
viewContactDeleted,
viewContactGroups,
viewContactsList,
viewUserContactLinkCreated,
viewUserContactLinkDeleted,
viewUserContactLink,
viewAcceptingContactRequest,
viewContactRequestRejected,
viewGroupCreated,
viewSentGroupInvitation,
viewCannotResendInvitation,
viewDeletedMember,
viewLeftMemberUser,
viewGroupDeletedUser,
viewGroupMembers,
viewSentFileInfo,
viewRcvFileAccepted,
viewRcvFileSndCancelled,
viewSndGroupFileCancelled,
viewRcvFileCancelled,
viewFileTransferStatus,
viewUserProfileUpdated,
viewUserProfile,
viewChatError,
viewSentMessage,
viewSentGroupMessage,
viewSentGroupFileInvitation,
viewSentFileInvitation,
viewGroupsList,
viewContactSubscribed,
viewContactSubError,
viewGroupInvitation,
viewGroupEmpty,
viewGroupRemoved,
viewMemberSubError,
viewGroupSubscribed,
viewSndFileSubError,
viewRcvFileSubError,
viewUserContactLinkSubscribed,
viewUserContactLinkSubError,
viewContactConnected,
viewContactDisconnected,
viewContactAnotherClient,
viewJoinedGroupMember,
viewUserJoinedGroup,
viewJoinedGroupMemberConnecting,
viewConnectedToGroupMember,
viewReceivedGroupInvitation,
viewDeletedMemberUser,
viewLeftMember,
viewSndFileStart,
viewSndFileComplete,
viewSndFileCancelled,
viewSndFileRcvCancelled,
viewRcvFileStart,
viewRcvFileComplete,
viewReceivedContactRequest,
viewMessageError,
viewReceivedMessage,
viewReceivedGroupMessage,
viewReceivedFileInvitation,
viewReceivedGroupFileInvitation,
viewContactUpdated,
viewContactsMerged,
viewGroupDeleted,
)
where
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.ByteString.Char8 (ByteString)
import Data.Composition ((.:), (.:.))
import Data.Composition ((.:))
import Data.Function (on)
import Data.Int (Int64)
import Data.List (groupBy, intersperse, sort, sortOn)
@ -99,7 +97,6 @@ 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
@ -107,227 +104,25 @@ 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)
viewSentConfirmation :: [StyledString]
viewSentConfirmation = ["confirmation sent!"]
showInvitation :: ChatReader m => ConnReqInvitation -> m ()
showInvitation = printToView . connReqInvitation_
viewSentInvitation :: [StyledString]
viewSentInvitation = ["connection request sent!"]
showSentConfirmation :: ChatReader m => m ()
showSentConfirmation = printToView ["confirmation sent!"]
viewInvalidConnReq :: [StyledString]
viewInvalidConnReq =
[ "",
"Connection link is invalid, possibly it was created in a previous version.",
"Please ask your contact to check " <> highlight' "/version" <> " and update if needed.",
plain updateStr
]
showSentInvitation :: ChatReader m => m ()
showSentInvitation = printToView ["connection request sent!"]
viewUserContactLinkSubscribed :: [StyledString]
viewUserContactLinkSubscribed = ["Your address is active! To show: " <> highlight' "/sa"]
showInvalidConnReq :: ChatReader m => m ()
showInvalidConnReq =
printToView
[ "",
"Connection link is invalid, possibly it was created in a previous version.",
"Please ask your contact to check " <> highlight' "/version" <> " and update if needed.",
plain updateStr
]
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 =
viewConnReqInvitation :: ConnReqInvitation -> [StyledString]
viewConnReqInvitation cReq =
[ "pass this invitation link to your contact (via another channel): ",
"",
(plain . strEncode) cReq,
@ -335,48 +130,48 @@ connReqInvitation_ cReq =
"and ask them to connect: " <> highlight' "/c <invitation_link_above>"
]
contactDeleted :: ContactName -> [StyledString]
contactDeleted c = [ttyContact c <> ": contact is deleted"]
viewContactDeleted :: ContactName -> [StyledString]
viewContactDeleted 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]
viewContactGroups :: ContactName -> [GroupName] -> [StyledString]
viewContactGroups 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 =
viewContactsList :: [Contact] -> [StyledString]
viewContactsList =
let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
in map ttyFullContact . sortOn ldn
contactConnected :: Contact -> [StyledString]
contactConnected ct = [ttyFullContact ct <> ": contact is connected"]
viewContactConnected :: Contact -> [StyledString]
viewContactConnected ct = [ttyFullContact ct <> ": contact is connected"]
contactDisconnected :: ContactName -> [StyledString]
contactDisconnected c = [ttyContact c <> ": disconnected from server (messages will be queued)"]
viewContactDisconnected :: ContactName -> [StyledString]
viewContactDisconnected c = [ttyContact c <> ": disconnected from server (messages will be queued)"]
contactAnotherClient :: ContactName -> [StyledString]
contactAnotherClient c = [ttyContact c <> ": contact is connected to another client"]
viewContactAnotherClient :: ContactName -> [StyledString]
viewContactAnotherClient c = [ttyContact c <> ": contact is connected to another client"]
contactSubscribed :: ContactName -> [StyledString]
contactSubscribed c = [ttyContact c <> ": connected to server"]
viewContactSubscribed :: ContactName -> [StyledString]
viewContactSubscribed c = [ttyContact c <> ": connected to server"]
contactSubError :: ContactName -> ChatError -> [StyledString]
contactSubError c e = [ttyContact c <> ": contact error " <> sShow e]
viewContactSubError :: ContactName -> ChatError -> [StyledString]
viewContactSubError c e = [ttyContact c <> ": contact error " <> sShow e]
userContactLinkCreated :: ConnReqContact -> [StyledString]
userContactLinkCreated = connReqContact_ "Your new chat address is created!"
viewUserContactLinkCreated :: ConnReqContact -> [StyledString]
viewUserContactLinkCreated = connReqContact_ "Your new chat address is created!"
userContactLinkDeleted :: [StyledString]
userContactLinkDeleted =
viewUserContactLinkDeleted :: [StyledString]
viewUserContactLinkDeleted =
[ "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:"
viewUserContactLink :: ConnReqContact -> [StyledString]
viewUserContactLink = connReqContact_ "Your chat address:"
connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
connReqContact_ intro cReq =
@ -389,90 +184,90 @@ connReqContact_ intro cReq =
"to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
]
receivedContactRequest :: ContactName -> Profile -> [StyledString]
receivedContactRequest c Profile {fullName} =
viewReceivedContactRequest :: ContactName -> Profile -> [StyledString]
viewReceivedContactRequest 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..."]
viewAcceptingContactRequest :: ContactName -> [StyledString]
viewAcceptingContactRequest c = [ttyContact c <> ": accepting contact request..."]
contactRequestRejected :: ContactName -> [StyledString]
contactRequestRejected c = [ttyContact c <> ": contact request rejected"]
viewContactRequestRejected :: ContactName -> [StyledString]
viewContactRequestRejected c = [ttyContact c <> ": contact request rejected"]
userContactLinkSubError :: ChatError -> [StyledString]
userContactLinkSubError e =
viewUserContactLinkSubError :: ChatError -> [StyledString]
viewUserContactLinkSubError e =
[ "user address error: " <> sShow e,
"to delete your address: " <> highlight' "/da"
]
groupSubscribed :: Group -> [StyledString]
groupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"]
viewGroupSubscribed :: Group -> [StyledString]
viewGroupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"]
groupEmpty :: Group -> [StyledString]
groupEmpty g = [ttyFullGroup g <> ": group is empty"]
viewGroupEmpty :: Group -> [StyledString]
viewGroupEmpty g = [ttyFullGroup g <> ": group is empty"]
groupRemoved :: Group -> [StyledString]
groupRemoved g = [ttyFullGroup g <> ": you are no longer a member or group deleted"]
viewGroupRemoved :: Group -> [StyledString]
viewGroupRemoved 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]
viewMemberSubError :: GroupName -> ContactName -> ChatError -> [StyledString]
viewMemberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> sShow e]
groupCreated :: Group -> [StyledString]
groupCreated g@Group {localDisplayName} =
viewGroupCreated :: Group -> [StyledString]
viewGroupCreated g@Group {localDisplayName} =
[ "group " <> ttyFullGroup g <> " is created",
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
]
groupDeletedUser :: GroupName -> [StyledString]
groupDeletedUser g = groupDeleted_ g Nothing
viewGroupDeletedUser :: GroupName -> [StyledString]
viewGroupDeletedUser 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"]
viewGroupDeleted :: GroupName -> GroupMember -> [StyledString]
viewGroupDeleted 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]
viewSentGroupInvitation :: GroupName -> ContactName -> [StyledString]
viewSentGroupInvitation g c = ["invitation to join the group " <> ttyGroup g <> " sent to " <> ttyContact c]
cannotResendInvitation :: GroupName -> ContactName -> [StyledString]
cannotResendInvitation g c =
viewCannotResendInvitation :: GroupName -> ContactName -> [StyledString]
viewCannotResendInvitation 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 =
viewReceivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
viewReceivedGroupInvitation 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 "]
viewJoinedGroupMember :: GroupName -> GroupMember -> [StyledString]
viewJoinedGroupMember g m = [ttyGroup g <> ": " <> ttyMember m <> " joined the group "]
userJoinedGroup :: GroupName -> [StyledString]
userJoinedGroup g = [ttyGroup g <> ": you joined the group"]
viewUserJoinedGroup :: GroupName -> [StyledString]
viewUserJoinedGroup 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...)"]
viewJoinedGroupMemberConnecting :: GroupName -> GroupMember -> GroupMember -> [StyledString]
viewJoinedGroupMemberConnecting 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"]
viewConnectedToGroupMember :: GroupName -> GroupMember -> [StyledString]
viewConnectedToGroupMember 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"]
viewDeletedMember :: GroupName -> Maybe GroupMember -> Maybe GroupMember -> [StyledString]
viewDeletedMember 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
viewDeletedMemberUser :: GroupName -> GroupMember -> [StyledString]
viewDeletedMemberUser g by = viewDeletedMember g (Just by) Nothing <> groupPreserved g
leftMemberUser :: GroupName -> [StyledString]
leftMemberUser g = leftMember_ g Nothing <> groupPreserved g
viewLeftMemberUser :: GroupName -> [StyledString]
viewLeftMemberUser g = leftMember_ g Nothing <> groupPreserved g
leftMember :: GroupName -> GroupMember -> [StyledString]
leftMember g m = leftMember_ g (Just m)
viewLeftMember :: GroupName -> GroupMember -> [StyledString]
viewLeftMember g m = leftMember_ g (Just m)
leftMember_ :: GroupName -> Maybe GroupMember -> [StyledString]
leftMember_ g m = [ttyGroup g <> ": " <> memberOrUser m <> " left the group"]
@ -489,8 +284,8 @@ connectedMember m = case memberCategory m of
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
viewGroupMembers :: Group -> [StyledString]
viewGroupMembers 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
@ -509,13 +304,17 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
GSMemCreator -> "created group"
_ -> ""
groupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString]
groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
groupsList gs = map groupSS $ sort gs
viewGroupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString]
viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
viewGroupsList gs = map groupSS $ sort gs
where
groupSS (displayName, fullName, GSMemInvited) = groupInvitation displayName fullName
groupSS (displayName, fullName, _) = ttyGroup displayName <> optFullName displayName fullName
viewGroupInvitation :: Group -> [StyledString]
viewGroupInvitation Group {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
[groupInvitation ldn fullName]
groupInvitation :: GroupName -> Text -> StyledString
groupInvitation displayName fullName =
highlight ("#" <> displayName)
@ -526,21 +325,21 @@ groupInvitation displayName fullName =
<> highlight ("/d #" <> displayName)
<> " to delete invitation)"
contactsMerged :: Contact -> Contact -> [StyledString]
contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} =
viewContactsMerged :: Contact -> Contact -> [StyledString]
viewContactsMerged _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} =
viewUserProfile :: Profile -> [StyledString]
viewUserProfile 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
viewUserProfileUpdated :: User -> User -> [StyledString]
viewUserProfileUpdated
User {localDisplayName = n, profile = Profile {fullName}}
User {localDisplayName = n', profile = Profile {fullName = fullName'}}
| n == n' && fullName == fullName' = []
@ -549,8 +348,8 @@ userProfileUpdated
where
notified = " (your contacts are notified)"
contactUpdated :: Contact -> Contact -> [StyledString]
contactUpdated
viewContactUpdated :: Contact -> Contact -> [StyledString]
viewContactUpdated
Contact {localDisplayName = n, profile = Profile {fullName}}
Contact {localDisplayName = n', profile = Profile {fullName = fullName'}}
| n == n' && fullName == fullName' = []
@ -562,11 +361,17 @@ contactUpdated
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]
viewMessageError :: Text -> Text -> [StyledString]
viewMessageError prefix err = [plain prefix <> ": " <> plain err]
receivedMessage :: StyledString -> UTCTime -> [StyledString] -> MsgIntegrity -> IO [StyledString]
receivedMessage from utcTime msg mOk = do
viewReceivedMessage :: ContactName -> UTCTime -> [StyledString] -> MsgIntegrity -> IO [StyledString]
viewReceivedMessage = viewReceivedMessage_ . ttyFromContact
viewReceivedGroupMessage :: GroupName -> ContactName -> UTCTime -> [StyledString] -> MsgIntegrity -> IO [StyledString]
viewReceivedGroupMessage = viewReceivedMessage_ .: ttyFromGroup
viewReceivedMessage_ :: StyledString -> UTCTime -> [StyledString] -> MsgIntegrity -> IO [StyledString]
viewReceivedMessage_ from utcTime msg mOk = do
t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime
pure $ prependFirst (t <> " " <> from) msg ++ showIntegrity mOk
where
@ -591,14 +396,26 @@ receivedMessage from utcTime msg mOk = do
msgError :: String -> [StyledString]
msgError s = [styled (Colored Red) s]
sentMessage :: StyledString -> ByteString -> IO [StyledString]
sentMessage to msg = sendWithTime_ to . msgPlain $ safeDecodeUtf8 msg
viewSentMessage :: ContactName -> ByteString -> IO [StyledString]
viewSentMessage = viewSentMessage_ . ttyToContact
sentFileInvitation :: StyledString -> FilePath -> IO [StyledString]
sentFileInvitation to f = sendWithTime_ ("/f " <> to) [ttyFilePath f]
viewSentGroupMessage :: GroupName -> ByteString -> IO [StyledString]
viewSentGroupMessage = viewSentMessage_ . ttyToGroup
sendWithTime_ :: StyledString -> [StyledString] -> IO [StyledString]
sendWithTime_ to styledMsg = do
viewSentMessage_ :: StyledString -> ByteString -> IO [StyledString]
viewSentMessage_ to msg = sentWithTime_ to . msgPlain $ safeDecodeUtf8 msg
viewSentFileInvitation :: ContactName -> FilePath -> IO [StyledString]
viewSentFileInvitation = viewSentFileInvitation_ . ttyToContact
viewSentGroupFileInvitation :: GroupName -> FilePath -> IO [StyledString]
viewSentGroupFileInvitation = viewSentFileInvitation_ . ttyToGroup
viewSentFileInvitation_ :: StyledString -> FilePath -> IO [StyledString]
viewSentFileInvitation_ to f = sentWithTime_ ("/f " <> to) [ttyFilePath f]
sentWithTime_ :: StyledString -> [StyledString] -> IO [StyledString]
sentWithTime_ to styledMsg = do
time <- formatTime defaultTimeLocale "%H:%M" <$> getZonedTime
pure $ prependFirst (styleTime time <> " " <> to) styledMsg
@ -609,21 +426,21 @@ prependFirst s (s' : ss) = (s <> s') : ss
msgPlain :: Text -> [StyledString]
msgPlain = map styleMarkdownText . T.lines
sentFileInfo :: Int64 -> [StyledString]
sentFileInfo fileId =
viewSentFileInfo :: Int64 -> [StyledString]
viewSentFileInfo fileId =
["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
sndFileStart :: SndFileTransfer -> [StyledString]
sndFileStart = sendingFile_ "started"
viewSndFileStart :: SndFileTransfer -> [StyledString]
viewSndFileStart = sendingFile_ "started"
sndFileComplete :: SndFileTransfer -> [StyledString]
sndFileComplete = sendingFile_ "completed"
viewSndFileComplete :: SndFileTransfer -> [StyledString]
viewSndFileComplete = sendingFile_ "completed"
sndFileCancelled :: SndFileTransfer -> [StyledString]
sndFileCancelled = sendingFile_ "cancelled"
viewSndFileCancelled :: SndFileTransfer -> [StyledString]
viewSndFileCancelled = sendingFile_ "cancelled"
sndGroupFileCancelled :: [SndFileTransfer] -> [StyledString]
sndGroupFileCancelled fts =
viewSndGroupFileCancelled :: [SndFileTransfer] -> [StyledString]
viewSndGroupFileCancelled 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]
@ -632,15 +449,21 @@ 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} =
viewSndFileRcvCancelled :: SndFileTransfer -> [StyledString]
viewSndFileRcvCancelled 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}} =
viewReceivedFileInvitation :: ContactName -> UTCTime -> RcvFileTransfer -> MsgIntegrity -> IO [StyledString]
viewReceivedFileInvitation c ts = viewReceivedMessage c ts . receivedFileInvitation_
viewReceivedGroupFileInvitation :: GroupName -> ContactName -> UTCTime -> RcvFileTransfer -> MsgIntegrity -> IO [StyledString]
viewReceivedGroupFileInvitation g c ts = viewReceivedGroupMessage g c ts . receivedFileInvitation_
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"
]
@ -657,25 +480,25 @@ humanReadableSize size
mB = kB * 1024
gB = mB * 1024
rcvFileAccepted :: RcvFileTransfer -> FilePath -> [StyledString]
rcvFileAccepted RcvFileTransfer {fileId, senderDisplayName = c} filePath =
viewRcvFileAccepted :: RcvFileTransfer -> FilePath -> [StyledString]
viewRcvFileAccepted RcvFileTransfer {fileId, senderDisplayName = c} filePath =
["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath]
rcvFileStart :: RcvFileTransfer -> [StyledString]
rcvFileStart = receivingFile_ "started"
viewRcvFileStart :: RcvFileTransfer -> [StyledString]
viewRcvFileStart = receivingFile_ "started"
rcvFileComplete :: RcvFileTransfer -> [StyledString]
rcvFileComplete = receivingFile_ "completed"
viewRcvFileComplete :: RcvFileTransfer -> [StyledString]
viewRcvFileComplete = receivingFile_ "completed"
rcvFileCancelled :: RcvFileTransfer -> [StyledString]
rcvFileCancelled = receivingFile_ "cancelled"
viewRcvFileCancelled :: RcvFileTransfer -> [StyledString]
viewRcvFileCancelled = 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} =
viewRcvFileSndCancelled :: RcvFileTransfer -> [StyledString]
viewRcvFileSndCancelled ft@RcvFileTransfer {senderDisplayName = c} =
[ttyContact c <> " cancelled sending " <> rcvFile ft]
rcvFile :: RcvFileTransfer -> StyledString
@ -684,8 +507,8 @@ rcvFile RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} = f
fileTransfer :: Int64 -> String -> StyledString
fileTransfer fileId fileName = "file " <> sShow fileId <> " (" <> ttyFilePath fileName <> ")"
fileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
fileTransferStatus (FTSnd [ft@SndFileTransfer {fileStatus, fileSize, chunkSize}], chunksNum) =
viewFileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
viewFileTransferStatus (FTSnd [ft@SndFileTransfer {fileStatus, fileSize, chunkSize}], chunksNum) =
["sending " <> sndFile ft <> " " <> sndStatus]
where
sndStatus = case fileStatus of
@ -694,8 +517,8 @@ fileTransferStatus (FTSnd [ft@SndFileTransfer {fileStatus, fileSize, chunkSize}]
FSConnected -> "progress " <> fileProgress chunksNum chunkSize fileSize
FSComplete -> "complete"
FSCancelled -> "cancelled"
fileTransferStatus (FTSnd [], _) = ["no file transfers (empty group)"]
fileTransferStatus (FTSnd fts@(ft : _), chunksNum) =
viewFileTransferStatus (FTSnd [], _) = ["no file transfers (empty group)"]
viewFileTransferStatus (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
@ -710,7 +533,7 @@ fileTransferStatus (FTSnd fts@(ft : _), chunksNum) =
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) =
viewFileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileSize}, fileStatus, chunkSize}, chunksNum) =
["receiving " <> rcvFile ft <> " " <> rcvStatus]
where
rcvStatus = case fileStatus of
@ -727,16 +550,16 @@ 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 =
viewSndFileSubError :: SndFileTransfer -> ChatError -> [StyledString]
viewSndFileSubError SndFileTransfer {fileId, fileName} e =
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
rcvFileSubError :: RcvFileTransfer -> ChatError -> [StyledString]
rcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e =
viewRcvFileSubError :: RcvFileTransfer -> ChatError -> [StyledString]
viewRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e =
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
chatError :: ChatError -> [StyledString]
chatError = \case
viewChatError :: ChatError -> [StyledString]
viewChatError = \case
ChatError err -> case err of
CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
@ -777,9 +600,6 @@ chatError = \case
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)

8
stack.yaml
View file

@ -40,12 +40,12 @@ extra-deps:
# - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
- github: simplex-chat/haskell-terminal
commit: f708b00009b54890172068f168bf98508ffcd495
- simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
# - github: simplex-chat/simplexmq
# commit: bfa4911217b71527a6fbaf73b242b5684aaf9fce
- github: simplex-chat/simplexmq
commit: 670b3b79749bfb48a04ee40b8c441e9ca68ad41a
- github: simplex-chat/hs-tls
commit: cea6d52c512716ff09adcac86ebc95bb0b3bb797
commit: f6cc753611f80af300401cfae63846e9d7c40d9e
subdirs:
- core

15
tests/ChatClient.hs
View file

@ -18,6 +18,8 @@ import Simplex.Chat
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..))
import Simplex.Chat.Options
import Simplex.Chat.Store
import Simplex.Chat.Terminal
import Simplex.Chat.Terminal.Output (newChatTerminal)
import Simplex.Chat.Types (Profile)
import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.RetryInterval
@ -38,7 +40,7 @@ serverPort = "5001"
opts :: ChatOpts
opts =
ChatOpts
{ dbFile = undefined,
{ dbFilePrefix = undefined,
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
logging = False
}
@ -71,12 +73,13 @@ cfg =
}
virtualSimplexChat :: FilePath -> Profile -> IO TestCC
virtualSimplexChat dbFile profile = do
st <- createStore (dbFile <> "_chat.db") 1
void . runExceptT $ createUser st profile True
virtualSimplexChat dbFilePrefix profile = do
st <- createStore (dbFilePrefix <> "_chat.db") 1
Right user <- runExceptT $ createUser st profile True
t <- withVirtualTerminal termSettings pure
cc <- newChatController cfg opts {dbFile} t . const $ pure () -- no notifications
chatAsync <- async $ runSimplexChat cc
ct <- newChatTerminal t
cc <- newChatController st user cfg opts {dbFilePrefix} . const $ pure () -- no notifications
chatAsync <- async $ runSimplexChat user ct cc
termQ <- newTQueueIO
termAsync <- async $ readTerminalOutput t termQ
pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ}