Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion simplexmq.cabal
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
cabal-version: 3.0

name: simplexmq
version: 7.0.0.3
version: 7.0.0.6
synopsis: SimpleXMQ message broker
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
<./docs/Simplex-Messaging-Client.html client> and
Expand Down
2 changes: 1 addition & 1 deletion src/Simplex/FileTransfer/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
let HTTP2Client {sessionId, sessionALPN} = http2Client
v = VersionXFTP 1
thServerVRange = versionToRange v
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False, serverInfo = Nothing}
logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
thParams@THandleParams {thVersion} <- case sessionALPN of
Just alpn
Expand Down
2 changes: 1 addition & 1 deletion src/Simplex/FileTransfer/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -157,7 +157,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
reqBody <- getHTTP2Body r xftpBlockSize
let v = VersionXFTP 1
thServerVRange = versionToRange v
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False, serverInfo = Nothing}
req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, sniUsed, addCORS = addCORS'}
flip runReaderT env $ case sessionALPN of
Nothing -> processRequest req0
Expand Down
113 changes: 53 additions & 60 deletions src/Simplex/Messaging/Agent.hs

Large diffs are not rendered by default.

15 changes: 11 additions & 4 deletions src/Simplex/Messaging/Agent/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -304,11 +304,12 @@ import Simplex.Messaging.Protocol
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Protocol.Types
import Simplex.Messaging.Server.QueueStore.QueueInfo
import Simplex.Messaging.Server.Information (ServerPublicInfo)
import Simplex.Messaging.Session
import Simplex.Messaging.SystemTime
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion, serverInfo), TransportError (..), TransportPeer (..), sndAuthKeySMPVersion, shortLinksSMPVersion, newNtfCredsSMPVersion)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.Credentials
import Simplex.Messaging.Util
Expand Down Expand Up @@ -1281,7 +1282,7 @@ data ProtocolTestFailure = ProtocolTestFailure
}
deriving (Eq, Show)

runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Maybe ProtocolTestFailure)
runSMPServerTest :: AgentClient -> NetworkRequestMode -> UserId -> SMPServerWithAuth -> AM' (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth srv auth) = do
cfg <- getClientConfig c smpCfg
C.AuthAlg ra <- asks $ rcvAuthAlg . config
Expand All @@ -1292,6 +1293,9 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
ts <- readTVarIO $ proxySessTs c
getProtocolClient g nm tSess cfg presetDomains Nothing ts (\_ -> pure ()) >>= \case
Right smp -> do
-- let serverInfo = case serverInfoBytes (thParams smp) of
-- Nothing -> Left "No server info received"
-- Just bs -> J.eitherDecodeStrict bs
rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
(sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
(dhKey, _) <- atomically $ C.generateKeyPair g
Expand All @@ -1303,8 +1307,11 @@ runSMPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
_ -> secureSMPQueue smp nm rpKey rcvId sKey
liftError (testErr TSDeleteQueue) $ deleteSMPQueue smp nm rpKey rcvId
ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient smp
pure $ either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok
Left e -> pure (Just $ testErr TSConnect e)
pure $ r >> maybe (Left (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const $ Right $ serverInfo (thParams smp)) ok
-- pure $ case either Just (const Nothing) r <|> maybe (Just (ProtocolTestFailure TSDisconnect $ BROKER addr TIMEOUT)) (const Nothing) ok of
-- Just failErr -> Left failErr
-- Nothing -> Right serverInfo
Left e -> pure $ Left (testErr TSConnect e)
where
addr = B.unpack $ strEncode srv
testErr :: ProtocolTestStep -> SMPClientError -> ProtocolTestFailure
Expand Down
10 changes: 5 additions & 5 deletions src/Simplex/Messaging/Agent/Store/AgentStore.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1359,11 +1359,11 @@ deleteSndMsgsExpired db ttl limit = do
|]
(cutoffTs, limit)

createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
createRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
createRatchetX3dhKeys :: DB.Connection -> ConnId -> CR.RcvE2EPrivRatchetParams 'C.X448 -> IO ()
createRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) =
DB.execute db "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem) VALUES (?, ?, ?, ?)" (connId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem)

getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams))
getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (CR.RcvE2EPrivRatchetParams 'C.X448))
getRatchetX3dhKeys db connId =
firstRow' keys SEX3dhKeysNotFound $
DB.query db "SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem FROM ratchets WHERE conn_id = ?" (Only connId)
Expand All @@ -1373,8 +1373,8 @@ getRatchetX3dhKeys db connId =
_ -> Left SEX3dhKeysNotFound

-- used to remember new keys when starting ratchet re-synchronization
setRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
setRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
setRatchetX3dhKeys :: DB.Connection -> ConnId -> CR.RcvE2EPrivRatchetParams 'C.X448 -> IO ()
setRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) =
DB.execute
db
[sql|
Expand Down
3 changes: 2 additions & 1 deletion src/Simplex/Messaging/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,8 @@ smpClientStub g sessionId thVersion thAuth = do
implySessId = thVersion >= authCmdsSMPVersion,
encryptBlock = Nothing,
batch = True,
serviceAuth = thVersion >= serviceCertsSMPVersion
serviceAuth = thVersion >= serviceCertsSMPVersion,
serverInfo = Nothing
},
sessionTs = ts,
client_ =
Expand Down
33 changes: 20 additions & 13 deletions src/Simplex/Messaging/Crypto/Ratchet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ module Simplex.Messaging.Crypto.Ratchet
AE2ERatchetParams (..),
E2ERatchetParamsUri (..),
E2ERatchetParams (..),
RcvE2EPrivRatchetParams,
VersionE2E,
VersionRangeE2E,
pattern VersionE2E,
Expand Down Expand Up @@ -403,24 +404,30 @@ instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toFiel

instance (Typeable s, RatchetKEMStateI s) => FromField (PrivRKEMParams s) where fromField = blobFieldDecoder smpDecode

type E2EPrivRatchetParams s a = (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s))\

type RcvE2EPrivRatchetParams a = E2EPrivRatchetParams 'RKSProposed a

type AE2EPrivRatchetParams a = (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams)

data UseKEM (s :: RatchetKEMState) where
ProposeKEM :: UseKEM 'RKSProposed
AcceptKEM :: KEMPublicKey -> UseKEM 'RKSAccepted

data AUseKEM = forall s. RatchetKEMStateI s => AUseKEM (SRatchetKEMState s) (UseKEM s)

mkRcvE2ERatchetParams :: VersionE2E -> (PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams) -> RcvE2ERatchetParams a
mkRcvE2ERatchetParams :: VersionE2E -> RcvE2EPrivRatchetParams a -> RcvE2ERatchetParams a
mkRcvE2ERatchetParams v (pk1, pk2, pKem) = E2ERatchetParams v (publicKey pk1) (publicKey pk2) (mkKem <$> pKem)
where
mkKem :: RcvPrivRKEMParams -> RcvRKEMParams
mkKem (PrivateRKParamsProposed (k, _)) = RKParamsProposed k

generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (E2EPrivRatchetParams s a, E2ERatchetParams s a)
generateE2EParams g v useKEM_ = do
(k1, pk1) <- atomically $ generateKeyPair g
(k2, pk2) <- atomically $ generateKeyPair g
kems <- kemParams
pure (pk1, pk2, snd <$> kems, E2ERatchetParams v k1 k2 (fst <$> kems))
pure ((pk1, pk2, snd <$> kems), E2ERatchetParams v k1 k2 (fst <$> kems))
where
kemParams :: IO (Maybe (RKEMParams s, PrivRKEMParams s))
kemParams = case useKEM_ of
Expand All @@ -436,7 +443,7 @@ generateE2EParams g v useKEM_ = do
_ -> pure Nothing

-- used by party initiating connection, Bob in double-ratchet spec
generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a)
generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (RcvE2EPrivRatchetParams a, RcvE2ERatchetParams a)
generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
where
proposeKEM_ :: PQSupport -> Maybe (UseKEM 'RKSProposed)
Expand All @@ -445,14 +452,14 @@ generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
PQSupportOff -> Nothing

-- used by party accepting connection, Alice in double-ratchet spec
generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams, AE2ERatchetParams a)
generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (AE2EPrivRatchetParams a, AE2ERatchetParams a)
generateSndE2EParams g v = \case
Nothing -> do
(pk1, pk2, _, e2eParams) <- generateE2EParams g v Nothing
pure (pk1, pk2, Nothing, AE2ERatchetParams SRKSProposed e2eParams)
((pk1, pk2, _), e2eParams) <- generateE2EParams g v Nothing
pure ((pk1, pk2, Nothing), AE2ERatchetParams SRKSProposed e2eParams)
Just (AUseKEM s useKEM) -> do
(pk1, pk2, pKem, e2eParams) <- generateE2EParams g v (Just useKEM)
pure (pk1, pk2, APRKP s <$> pKem, AE2ERatchetParams s e2eParams)
((pk1, pk2, pKem), e2eParams) <- generateE2EParams g v (Just useKEM)
pure ((pk1, pk2, APRKP s <$> pKem), AE2ERatchetParams s e2eParams)

data RatchetInitParams = RatchetInitParams
{ assocData :: Str,
Expand All @@ -464,9 +471,9 @@ data RatchetInitParams = RatchetInitParams
deriving (Show)

-- this is used by the peer joining the connection
pqX3dhSnd :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> Maybe APrivRKEMParams -> E2ERatchetParams 'RKSProposed a -> Either CryptoError (RatchetInitParams, Maybe KEMKeyPair)
pqX3dhSnd :: DhAlgorithm a => AE2EPrivRatchetParams a -> E2ERatchetParams 'RKSProposed a -> Either CryptoError (RatchetInitParams, Maybe KEMKeyPair)
-- 3. replied 2. received
pqX3dhSnd spk1 spk2 spKem_ (E2ERatchetParams v rk1 rk2 rKem_) = do
pqX3dhSnd (spk1, spk2, spKem_) (E2ERatchetParams v rk1 rk2 rKem_) = do
(ks_, kem_) <- sndPq
let initParams = pqX3dh (publicKey spk1, rk1) (dh' rk1 spk2) (dh' rk2 spk1) (dh' rk2 spk2) kem_
pure (initParams, ks_)
Expand All @@ -480,9 +487,9 @@ pqX3dhSnd spk1 spk2 spKem_ (E2ERatchetParams v rk1 rk2 rKem_) = do
_ -> Right (Nothing, Nothing)

-- this is used by the peer that created new connection, after receiving the reply
pqX3dhRcv :: forall s a. (RatchetKEMStateI s, DhAlgorithm a) => PrivateKey a -> PrivateKey a -> Maybe (PrivRKEMParams 'RKSProposed) -> E2ERatchetParams s a -> ExceptT CryptoError IO (RatchetInitParams, Maybe KEMKeyPair)
pqX3dhRcv :: forall s a. (RatchetKEMStateI s, DhAlgorithm a) => RcvE2EPrivRatchetParams a -> E2ERatchetParams s a -> ExceptT CryptoError IO (RatchetInitParams, Maybe KEMKeyPair)
-- 1. sent 4. received in reply
pqX3dhRcv rpk1 rpk2 rpKem_ (E2ERatchetParams v sk1 sk2 sKem_) = do
pqX3dhRcv (rpk1, rpk2, rpKem_) (E2ERatchetParams v sk1 sk2 sKem_) = do
kem_ <- rcvPq
let initParams = pqX3dh (sk1, publicKey rpk1) (dh' sk2 rpk1) (dh' sk1 rpk2) (dh' sk2 rpk2) (snd <$> kem_)
pure (initParams, fst <$> kem_)
Expand Down
3 changes: 2 additions & 1 deletion src/Simplex/Messaging/Notifications/Transport.hs
Original file line number Diff line number Diff line change
Expand Up @@ -186,5 +186,6 @@ ntfTHandle c = THandle {connection = c, params}
implySessId = False,
encryptBlock = Nothing,
batch = False,
serviceAuth = False
serviceAuth = False,
serverInfo = Nothing
}
7 changes: 5 additions & 2 deletions src/Simplex/Messaging/Protocol.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1546,11 +1546,14 @@ queueIdHash = IdsHash . C.md5Hash . unEntityId
{-# INLINE queueIdHash #-}

addServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
addServiceSubs (n', idsHash') (n, idsHash) = (n + n', idsHash <> idsHash')
addServiceSubs (n', idsHash') (n, idsHash) =
let !n'' = n + n'
!h = idsHash <> idsHash'
in (n'', h)

subtractServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
subtractServiceSubs (n', idsHash') (n, idsHash)
| n > n' = (n - n', idsHash <> idsHash') -- concat is a reversible xor: (x `xor` y) `xor` y == x
| n > n' = let !n'' = n - n'; !h = idsHash <> idsHash' in (n'', h) -- concat is a reversible xor: (x `xor` y) `xor` y == x
| otherwise = (0, mempty)

data ProtocolErrorType = PECmdSyntax | PECmdUnknown | PESession | PEBlock
Expand Down
6 changes: 4 additions & 2 deletions src/Simplex/Messaging/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ import Control.Monad.Trans.Except
import Control.Monad.STM (retry)
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (first, second)
import qualified Data.Aeson as J
import Data.ByteString.Base64 (encode)
import qualified Data.ByteString.Builder as BLD
import Data.ByteString.Char8 (ByteString)
Expand Down Expand Up @@ -739,9 +740,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
idSize <- asks $ queueIdBytes . config
kh <- asks serverIdentity
ks <- atomically . C.generateKeyPair =<< asks random
ServerConfig {smpServerVRange, smpHandshakeTimeout} <- asks config
ServerConfig {smpServerVRange, smpHandshakeTimeout, information} <- asks config
let serverInfo = LB.toStrict . J.encode <$> information
labelMyThread $ "smp handshake for " <> transportName tp
liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange $ getClientService ms g idSize) >>= \case
liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange serverInfo $ getClientService ms g idSize) >>= \case
Just (Right th) -> runClientTransport th
_ -> pure ()

Expand Down
3 changes: 1 addition & 2 deletions src/Simplex/Messaging/Server/Information.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Int (Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
import Simplex.Messaging.Agent.Protocol (ConnectionLink, ConnectionMode (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)

Expand Down Expand Up @@ -112,7 +111,7 @@ data Entity = Entity {name :: Text, country :: Maybe Text}
deriving (Show)

data ServerContactAddress = ServerContactAddress
{ simplex :: Maybe (ConnectionLink 'CMContact),
{ simplex :: Maybe Text,
email :: Maybe Text, -- it is recommended that it matches DNS email address, if either is present
pgp :: Maybe PGPKey
}
Expand Down
9 changes: 5 additions & 4 deletions src/Simplex/Messaging/Server/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import qualified Data.Text.IO as T
import Options.Applicative
import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), connReqUriP')
import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), ConnectionMode (..), connReqUriP')
import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
Expand All @@ -85,7 +85,7 @@ import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupp
import Simplex.Messaging.Transport.Client (TransportHost (..), defaultSocksProxy)
import Simplex.Messaging.Transport.HTTP2 (httpALPN)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
import Simplex.Messaging.Util (eitherToMaybe, ifM)
import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
import System.Exit (exitFailure)
import System.FilePath (combine)
Expand Down Expand Up @@ -786,12 +786,13 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
<$!> infoValue nameField
countryValue field = (either error id . validCountryValue (T.unpack field) . T.unpack) <$!> infoValue field
iniContacts simplexField emailField pgpKeyUriField pgpKeyFingerprintField =
let simplex = either error id . parseAll linkP . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
let addr :: Maybe (ConnectionLink 'CMContact) = either error id . parseAll linkP . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
simplex = safeDecodeUtf8 . strEncode <$> addr
linkP = CLFull <$> connReqUriP' Nothing <|> CLShort <$> strP
email = infoValue emailField
pkURI_ = infoValue pgpKeyUriField
pkFingerprint_ = infoValue pgpKeyFingerprintField
in case (simplex, email, pkURI_, pkFingerprint_) of
in case (addr, email, pkURI_, pkFingerprint_) of
(Nothing, Nothing, Nothing, _) -> Nothing
(Nothing, Nothing, _, Nothing) -> Nothing
(_, _, pkURI, pkFingerprint) -> Just ServerContactAddress {simplex, email, pgp = PGPKey <$> pkURI <*> pkFingerprint}
Expand Down
4 changes: 2 additions & 2 deletions src/Simplex/Messaging/Server/Web.hs
Original file line number Diff line number Diff line change
Expand Up @@ -270,14 +270,14 @@ serverInfoSubsts simplexmqSource information =
]
admin ServerContactAddress {simplex, email, pgp} =
[ ("admin", Just ""),
("adminSimplex", strEncode <$> simplex),
("adminSimplex", encodeUtf8 <$> simplex),
("adminEmail", encodeUtf8 <$> email),
("adminPGP", encodeUtf8 . pkURI <$> pgp),
("adminPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
]
complaints ServerContactAddress {simplex, email, pgp} =
[ ("complaints", Just ""),
("complaintsSimplex", strEncode <$> simplex),
("complaintsSimplex", encodeUtf8 <$> simplex),
("complaintsEmail", encodeUtf8 <$> email),
("complaintsPGP", encodeUtf8 . pkURI <$> pgp),
("complaintsPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
Expand Down
Loading
Loading