core: support SMP basic auth / server password (#1358)

This commit is contained in:
Evgeny Poberezkin
2022-11-14 08:04:11 +00:00
committed by GitHub
parent cb0c499f57
commit e14ab0fed0
13 changed files with 45 additions and 25 deletions
+1 -1
View File
@@ -105,7 +105,7 @@ defaultChatConfig =
testView = False
}
_defaultSMPServers :: NonEmpty SMPServer
_defaultSMPServers :: NonEmpty SMPServerWithAuth
_defaultSMPServers =
L.fromList
[ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion",
+2 -2
View File
@@ -186,7 +186,7 @@ data ChatCommand
| APIDeleteGroupLink GroupId
| APIGetGroupLink GroupId
| GetUserSMPServers
| SetUserSMPServers [SMPServer]
| SetUserSMPServers [SMPServerWithAuth]
| APISetChatItemTTL (Maybe Int64)
| APIGetChatItemTTL
| APISetNetworkConfig NetworkConfig
@@ -261,7 +261,7 @@ data ChatResponse
| CRApiChat {chat :: AChat}
| CRLastMessages {chatItems :: [AChatItem]}
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
| CRUserSMPServers {smpServers :: [SMPServer]}
| CRUserSMPServers {smpServers :: [SMPServerWithAuth]}
| CRChatItemTTL {chatItemTTL :: Maybe Int64}
| CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
@@ -0,0 +1,12 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221112_server_password where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20221112_server_password :: Query
m20221112_server_password =
[sql|
ALTER TABLE smp_servers ADD COLUMN basic_auth TEXT;
|]
@@ -384,6 +384,7 @@ CREATE TABLE smp_servers(
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now')),
basic_auth TEXT,
UNIQUE(host, port)
);
CREATE INDEX idx_messages_shared_msg_id ON messages(shared_msg_id);
+4 -4
View File
@@ -16,7 +16,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import Options.Applicative
import Simplex.Chat.Controller (updateStr, versionStr)
import Simplex.Messaging.Agent.Protocol (SMPServer)
import Simplex.Messaging.Agent.Protocol (SMPServerWithAuth)
import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
@@ -26,7 +26,7 @@ import System.FilePath (combine)
data ChatOpts = ChatOpts
{ dbFilePrefix :: String,
dbKey :: String,
smpServers :: [SMPServer],
smpServers :: [SMPServerWithAuth],
networkConfig :: NetworkConfig,
logConnections :: Bool,
logServerHosts :: Bool,
@@ -155,7 +155,7 @@ fullNetworkConfig socksProxy tcpTimeout =
let tcpConnectTimeout = (tcpTimeout * 3) `div` 2
in defaultNetworkConfig {socksProxy, tcpTimeout, tcpConnectTimeout}
parseSMPServers :: ReadM [SMPServer]
parseSMPServers :: ReadM [SMPServerWithAuth]
parseSMPServers = eitherReader $ parseAll smpServersP . B.pack
parseSocksProxy :: ReadM (Maybe SocksProxy)
@@ -167,7 +167,7 @@ parseServerPort = eitherReader $ parseAll serverPortP . B.pack
serverPortP :: A.Parser (Maybe String)
serverPortP = Just . B.unpack <$> A.takeWhile A.isDigit
smpServersP :: A.Parser [SMPServer]
smpServersP :: A.Parser [SMPServerWithAuth]
smpServersP = strP `A.sepBy1` A.char ';'
getChatOpts :: FilePath -> FilePath -> IO ChatOpts
+15 -12
View File
@@ -252,6 +252,7 @@ import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe)
import Data.Ord (Down (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
import Data.Type.Equality
@@ -295,6 +296,7 @@ import Simplex.Chat.Migrations.M20221021_auto_accept__group_links
import Simplex.Chat.Migrations.M20221024_contact_used
import Simplex.Chat.Migrations.M20221025_chat_settings
import Simplex.Chat.Migrations.M20221029_group_link_id
import Simplex.Chat.Migrations.M20221112_server_password
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -302,9 +304,9 @@ 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.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (ProtocolServer (..), SMPServer, pattern SMPServer)
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), SMPServerWithAuth, pattern SMPServer)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (eitherToMaybe)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
import UnliftIO.STM
schemaMigrations :: [(String, Query)]
@@ -341,7 +343,8 @@ schemaMigrations =
("20221021_auto_accept__group_links", m20221021_auto_accept__group_links),
("20221024_contact_used", m20221024_contact_used),
("20221025_chat_settings", m20221025_chat_settings),
("20221029_group_link_id", m20221029_group_link_id)
("20221029_group_link_id", m20221029_group_link_id),
("20221112_server_password", m20221112_server_password)
]
-- | The list of migrations in ascending order by date
@@ -4234,35 +4237,35 @@ toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_)
toGroupChatItemList _ _ _ _ = []
getSMPServers :: DB.Connection -> User -> IO [SMPServer]
getSMPServers :: DB.Connection -> User -> IO [SMPServerWithAuth]
getSMPServers db User {userId} =
map toSmpServer
<$> DB.query
db
[sql|
SELECT host, port, key_hash
SELECT host, port, key_hash, basic_auth
FROM smp_servers
WHERE user_id = ?;
|]
(Only userId)
where
toSmpServer :: (NonEmpty TransportHost, String, C.KeyHash) -> SMPServer
toSmpServer (host, port, keyHash) = SMPServer host port keyHash
toSmpServer :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text) -> SMPServerWithAuth
toSmpServer (host, port, keyHash, auth_) = ProtoServerWithAuth (SMPServer host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
overwriteSMPServers :: DB.Connection -> User -> [SMPServer] -> ExceptT StoreError IO ()
overwriteSMPServers :: DB.Connection -> User -> [SMPServerWithAuth] -> ExceptT StoreError IO ()
overwriteSMPServers db User {userId} smpServers =
checkConstraint SEUniqueID . ExceptT $ do
currentTs <- getCurrentTime
DB.execute db "DELETE FROM smp_servers WHERE user_id = ?" (Only userId)
forM_ smpServers $ \ProtocolServer {host, port, keyHash} ->
forM_ smpServers $ \(ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) ->
DB.execute
db
[sql|
INSERT INTO smp_servers
(host, port, key_hash, user_id, created_at, updated_at)
VALUES (?,?,?,?,?,?)
(host, port, key_hash, basic_auth, user_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?)
|]
(host, port, keyHash, userId, currentTs, currentTs)
(host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_, userId, currentTs, currentTs)
pure $ Right ()
createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
+2 -2
View File
@@ -618,7 +618,7 @@ viewUserProfile Profile {displayName, fullName} =
"(the updated profile will be sent to all your contacts)"
]
viewSMPServers :: [SMPServer] -> Bool -> [StyledString]
viewSMPServers :: [SMPServerWithAuth] -> Bool -> [StyledString]
viewSMPServers smpServers testView =
if testView
then [customSMPServers]
@@ -675,7 +675,7 @@ viewConnectionStats ConnectionStats {rcvServers, sndServers} =
["receiving messages via: " <> viewServerHosts rcvServers | not $ null rcvServers]
<> ["sending messages via: " <> viewServerHosts sndServers | not $ null sndServers]
viewServers :: [SMPServer] -> StyledString
viewServers :: [SMPServerWithAuth] -> StyledString
viewServers = plain . intercalate ", " . map (B.unpack . strEncode)
viewServerHosts :: [SMPServer] -> StyledString