diff --git a/apps/ios/.gitignore b/apps/ios/.gitignore new file mode 100644 index 0000000000..195fd5ee74 --- /dev/null +++ b/apps/ios/.gitignore @@ -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/ diff --git a/apps/ios/Shared/Assets.xcassets/AccentColor.colorset/Contents.json b/apps/ios/Shared/Assets.xcassets/AccentColor.colorset/Contents.json new file mode 100644 index 0000000000..eb87897008 --- /dev/null +++ b/apps/ios/Shared/Assets.xcassets/AccentColor.colorset/Contents.json @@ -0,0 +1,11 @@ +{ + "colors" : [ + { + "idiom" : "universal" + } + ], + "info" : { + "author" : "xcode", + "version" : 1 + } +} diff --git a/apps/ios/Shared/Assets.xcassets/AppIcon.appiconset/Contents.json b/apps/ios/Shared/Assets.xcassets/AppIcon.appiconset/Contents.json new file mode 100644 index 0000000000..c136eaff76 --- /dev/null +++ b/apps/ios/Shared/Assets.xcassets/AppIcon.appiconset/Contents.json @@ -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 + } +} diff --git a/apps/ios/Shared/Assets.xcassets/Contents.json b/apps/ios/Shared/Assets.xcassets/Contents.json new file mode 100644 index 0000000000..73c00596a7 --- /dev/null +++ b/apps/ios/Shared/Assets.xcassets/Contents.json @@ -0,0 +1,6 @@ +{ + "info" : { + "author" : "xcode", + "version" : 1 + } +} diff --git a/apps/ios/Shared/ContentView.swift b/apps/ios/Shared/ContentView.swift new file mode 100644 index 0000000000..c560668723 --- /dev/null +++ b/apps/ios/Shared/ContentView.swift @@ -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!") + } +} diff --git a/apps/ios/Shared/MessageView.swift b/apps/ios/Shared/MessageView.swift new file mode 100644 index 0000000000..76ebbc3341 --- /dev/null +++ b/apps/ios/Shared/MessageView.swift @@ -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) + } +} diff --git a/apps/ios/Shared/ProfileView.swift b/apps/ios/Shared/ProfileView.swift new file mode 100644 index 0000000000..a27f1ec9e2 --- /dev/null +++ b/apps/ios/Shared/ProfileView.swift @@ -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() + } +} diff --git a/apps/ios/Shared/SimpleXApp.swift b/apps/ios/Shared/SimpleXApp.swift new file mode 100644 index 0000000000..3598b4284a --- /dev/null +++ b/apps/ios/Shared/SimpleXApp.swift @@ -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() + } + } +} diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj new file mode 100644 index 0000000000..5a6c43804b --- /dev/null +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -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 = ""; }; + 5CA059C4279559F40002BEB4 /* ContentView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ContentView.swift; sourceTree = ""; }; + 5CA059C5279559F40002BEB4 /* Assets.xcassets */ = {isa = PBXFileReference; lastKnownFileType = folder.assetcatalog; path = Assets.xcassets; sourceTree = ""; }; + 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 = ""; }; + 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 = ""; }; + 5CA059DD279559F40002BEB4 /* Tests_iOSLaunchTests.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Tests_iOSLaunchTests.swift; sourceTree = ""; }; + 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 = ""; }; + 5CA059E9279559F40002BEB4 /* Tests_macOSLaunchTests.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Tests_macOSLaunchTests.swift; sourceTree = ""; }; + 5CA05A4B27974EB60002BEB4 /* ProfileView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ProfileView.swift; sourceTree = ""; }; + 5CA05A4E279752D00002BEB4 /* MessageView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MessageView.swift; sourceTree = ""; }; +/* 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 = ""; + }; + 5CA059C2279559F40002BEB4 /* Shared */ = { + isa = PBXGroup; + children = ( + 5CA059C3279559F40002BEB4 /* SimpleXApp.swift */, + 5CA059C4279559F40002BEB4 /* ContentView.swift */, + 5CA05A4B27974EB60002BEB4 /* ProfileView.swift */, + 5CA05A4E279752D00002BEB4 /* MessageView.swift */, + 5CA059C5279559F40002BEB4 /* Assets.xcassets */, + ); + path = Shared; + sourceTree = ""; + }; + 5CA059CB279559F40002BEB4 /* Products */ = { + isa = PBXGroup; + children = ( + 5CA059CA279559F40002BEB4 /* SimpleX.app */, + 5CA059D0279559F40002BEB4 /* SimpleX.app */, + 5CA059D7279559F40002BEB4 /* Tests iOS.xctest */, + 5CA059E3279559F40002BEB4 /* Tests macOS.xctest */, + ); + name = Products; + sourceTree = ""; + }; + 5CA059D1279559F40002BEB4 /* macOS */ = { + isa = PBXGroup; + children = ( + 5CA059D2279559F40002BEB4 /* macOS.entitlements */, + ); + path = macOS; + sourceTree = ""; + }; + 5CA059DA279559F40002BEB4 /* Tests iOS */ = { + isa = PBXGroup; + children = ( + 5CA059DB279559F40002BEB4 /* Tests_iOS.swift */, + 5CA059DD279559F40002BEB4 /* Tests_iOSLaunchTests.swift */, + ); + path = "Tests iOS"; + sourceTree = ""; + }; + 5CA059E6279559F40002BEB4 /* Tests macOS */ = { + isa = PBXGroup; + children = ( + 5CA059E7279559F40002BEB4 /* Tests_macOS.swift */, + 5CA059E9279559F40002BEB4 /* Tests_macOSLaunchTests.swift */, + ); + path = "Tests macOS"; + sourceTree = ""; + }; +/* 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 */; +} diff --git a/apps/ios/SimpleX.xcodeproj/project.xcworkspace/contents.xcworkspacedata b/apps/ios/SimpleX.xcodeproj/project.xcworkspace/contents.xcworkspacedata new file mode 100644 index 0000000000..919434a625 --- /dev/null +++ b/apps/ios/SimpleX.xcodeproj/project.xcworkspace/contents.xcworkspacedata @@ -0,0 +1,7 @@ + + + + + diff --git a/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/IDEWorkspaceChecks.plist b/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/IDEWorkspaceChecks.plist new file mode 100644 index 0000000000..18d981003d --- /dev/null +++ b/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/IDEWorkspaceChecks.plist @@ -0,0 +1,8 @@ + + + + + IDEDidComputeMac32BitWarning + + + diff --git a/apps/ios/Tests iOS/Tests_iOS.swift b/apps/ios/Tests iOS/Tests_iOS.swift new file mode 100644 index 0000000000..eeecf4d4fc --- /dev/null +++ b/apps/ios/Tests iOS/Tests_iOS.swift @@ -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() + } + } + } +} diff --git a/apps/ios/Tests iOS/Tests_iOSLaunchTests.swift b/apps/ios/Tests iOS/Tests_iOSLaunchTests.swift new file mode 100644 index 0000000000..d869e7357f --- /dev/null +++ b/apps/ios/Tests iOS/Tests_iOSLaunchTests.swift @@ -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) + } +} diff --git a/apps/ios/Tests macOS/Tests_macOS.swift b/apps/ios/Tests macOS/Tests_macOS.swift new file mode 100644 index 0000000000..ee05450dc0 --- /dev/null +++ b/apps/ios/Tests macOS/Tests_macOS.swift @@ -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() + } + } + } +} diff --git a/apps/ios/Tests macOS/Tests_macOSLaunchTests.swift b/apps/ios/Tests macOS/Tests_macOSLaunchTests.swift new file mode 100644 index 0000000000..84d51dadbd --- /dev/null +++ b/apps/ios/Tests macOS/Tests_macOSLaunchTests.swift @@ -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) + } +} diff --git a/apps/ios/macOS/macOS.entitlements b/apps/ios/macOS/macOS.entitlements new file mode 100644 index 0000000000..f2ef3ae026 --- /dev/null +++ b/apps/ios/macOS/macOS.entitlements @@ -0,0 +1,10 @@ + + + + + com.apple.security.app-sandbox + + com.apple.security.files.user-selected.read-only + + + diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index 55fe640014..cb223f6e0a 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -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 diff --git a/cabal.project b/cabal.project index 2ba37ee93c..38cea86b8d 100644 --- a/cabal.project +++ b/cabal.project @@ -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 diff --git a/package.yaml b/package.yaml index d8bfde04b2..68b2df3f6e 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/rfcs/2022-01-26-mobile-app.md b/rfcs/2022-01-26-mobile-app.md new file mode 100644 index 0000000000..56c2eb55c8 --- /dev/null +++ b/rfcs/2022-01-26-mobile-app.md @@ -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. diff --git a/simplex-chat.cabal b/simplex-chat.cabal index f63210aed3..0e43bfbf4f 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -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.* diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c7241bf7ed..a54690a2a5 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index c3d2d7d38d..509322a9b1 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -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' diff --git a/migrations/20220101_initial.sql b/src/Simplex/Chat/Migrations/M20220101_initial.hs similarity index 97% rename from migrations/20220101_initial.sql rename to src/Simplex/Chat/Migrations/M20220101_initial.hs index 27b8c5108a..a326ba0604 100644 --- a/migrations/20220101_initial.sql +++ b/src/Simplex/Chat/Migrations/M20220101_initial.hs @@ -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) ); +|] diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs new file mode 100644 index 0000000000..33cb548613 --- /dev/null +++ b/src/Simplex/Chat/Mobile.hs @@ -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": }` 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": }` or `{"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": }` or `{}` +chatGetUser :: ChatStore -> IO JSONString +chatGetUser ChatStore {chatStore} = + maybe "{}" (jsonObject . ("user" .=)) <$> getActiveUser_ chatStore + +-- | returns JSON in the form `{"user": }` or `{"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 diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index f7504aabda..a75909c368 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -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" diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 8efad9c137..d025d41296 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -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 diff --git a/src/Simplex/Chat/Styled.hs b/src/Simplex/Chat/Styled.hs index f7a3a80acf..a15bd90be4 100644 --- a/src/Simplex/Chat/Styled.hs +++ b/src/Simplex/Chat/Styled.hs @@ -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 diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index 24d613f486..5a658ca5da 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -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] diff --git a/src/Simplex/Chat/Input.hs b/src/Simplex/Chat/Terminal/Input.hs similarity index 92% rename from src/Simplex/Chat/Input.hs rename to src/Simplex/Chat/Terminal/Input.hs index 5369c3db9a..8c5f7b8cf7 100644 --- a/src/Simplex/Chat/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -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 () diff --git a/src/Simplex/Chat/Notification.hs b/src/Simplex/Chat/Terminal/Notification.hs similarity index 96% rename from src/Simplex/Chat/Notification.hs rename to src/Simplex/Chat/Terminal/Notification.hs index 3f4883205e..b1a5fee3e6 100644 --- a/src/Simplex/Chat/Notification.hs +++ b/src/Simplex/Chat/Terminal/Notification.hs @@ -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 diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs new file mode 100644 index 0000000000..4100504f77 --- /dev/null +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -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 diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 386fa732b6..078add3a13 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -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} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 96499a999e..9158bdf3d1 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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 " ] -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 <> " ") <> " 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 "] -groupsList gs = map groupSS $ sort gs +viewGroupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString] +viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g "] +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' "" <> " 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 []" <> " 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 <> " [/ | ]") <> " 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) diff --git a/stack.yaml b/stack.yaml index e7e09510eb..9310861bfb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -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 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 3e351a35e3..5a214e83a8 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -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}