diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index 83608ebcd..b15e45d83 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -46,7 +46,7 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport import System.Exit (exitFailure) import System.Mem.Weak (Weak) import UnliftIO.STM -import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient) +import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig) import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager) import Network.HTTP.Client.TLS (tlsManagerSettings) @@ -61,6 +61,7 @@ data NtfServerConfig = NtfServerConfig pushQSize :: Natural, smpAgentCfg :: SMPClientAgentConfig, apnsConfig :: APNSPushClientConfig, + wpConfig :: WebPushConfig, subsBatchSize :: Int, inactiveClientExpiration :: Maybe ExpirationConfig, dbStoreConfig :: PostgresStoreCfg, @@ -100,7 +101,7 @@ data NtfEnv = NtfEnv } newNtfServerEnv :: NtfServerConfig -> IO NtfEnv -newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbStoreConfig, ntfCredentials, useServiceCreds, startOptions} = do +newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, wpConfig, dbStoreConfig, ntfCredentials, useServiceCreds, startOptions} = do when (compactLog startOptions) $ compactDbStoreLog $ dbStoreLogPath dbStoreConfig random <- C.newRandom store <- newNtfDbStore dbStoreConfig @@ -116,7 +117,7 @@ newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbSt pure smpAgentCfg {smpCfg = (smpCfg smpAgentCfg) {serviceCredentials = Just service}} else pure smpAgentCfg subscriber <- newNtfSubscriber smpAgentCfg' random - pushServer <- newNtfPushServer pushQSize apnsConfig + pushServer <- newNtfPushServer pushQSize apnsConfig wpConfig serverStats <- newNtfServerStats =<< getCurrentTime pure NtfEnv {config, subscriber, pushServer, store, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats} where @@ -153,14 +154,15 @@ data SMPSubscriber = SMPSubscriber data NtfPushServer = NtfPushServer { pushQ :: TBQueue (Maybe T.Text, NtfTknRec, PushNotification), -- Maybe Text is a hostname of "own" server pushClients :: TMap PushProvider PushProviderClient, - apnsConfig :: APNSPushClientConfig + apnsConfig :: APNSPushClientConfig, + wpConfig :: WebPushConfig } -newNtfPushServer :: Natural -> APNSPushClientConfig -> IO NtfPushServer -newNtfPushServer qSize apnsConfig = do +newNtfPushServer :: Natural -> APNSPushClientConfig -> WebPushConfig -> IO NtfPushServer +newNtfPushServer qSize apnsConfig wpConfig = do pushQ <- newTBQueueIO qSize pushClients <- TM.emptyIO - pure NtfPushServer {pushQ, pushClients, apnsConfig} + pure NtfPushServer {pushQ, pushClients, apnsConfig, wpConfig} newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient newPushClient s pp = do diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs index de12c33f8..fd54680ba 100644 --- a/src/Simplex/Messaging/Notifications/Server/Main.hs +++ b/src/Simplex/Messaging/Notifications/Server/Main.hs @@ -11,7 +11,7 @@ module Simplex.Messaging.Notifications.Server.Main where import Control.Logger.Simple (setLogLevel) -import Control.Monad ((<$!>)) +import Control.Monad ( (<$!>), unless, void ) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import Data.Ini (lookupValue, readIniFile) @@ -56,6 +56,8 @@ import System.Exit (exitFailure) import System.FilePath (combine) import System.IO (BufferMode (..), hSetBuffering, stderr, stdout) import Text.Read (readMaybe) +import System.Process (readCreateProcess, shell) +import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..), VapidKey, mkVapid) ntfServerCLI :: FilePath -> FilePath -> IO () ntfServerCLI cfgPath logPath = @@ -146,6 +148,7 @@ ntfServerCLI cfgPath logPath = clearDirIfExists logPath createDirectoryIfMissing True cfgPath createDirectoryIfMissing True logPath + _ <- genVapidKey vapidKeyPath let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm} fp <- createServerX509 cfgPath x509cfg let host = fromMaybe (if ip == "127.0.0.1" then "" else ip) fqdn @@ -212,9 +215,10 @@ ntfServerCLI cfgPath logPath = hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering fp <- checkSavedFingerprint cfgPath defaultX509Config + vapidKey <- getVapidKey vapidKeyPath let host = either (const "") T.unpack $ lookupValue "TRANSPORT" "host" ini port = T.unpack $ strictIni "TRANSPORT" "port" ini - cfg@NtfServerConfig {transports} = serverConfig + cfg@NtfServerConfig {transports} = serverConfig vapidKey srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing printServiceInfo serverVersion srv printNtfServerConfig transports dbStoreConfig @@ -230,7 +234,7 @@ ntfServerCLI cfgPath logPath = confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini } - serverConfig = + serverConfig vapidKey = NtfServerConfig { transports = iniTransports ini, controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini, @@ -258,6 +262,7 @@ ntfServerCLI cfgPath logPath = persistErrorInterval = 0 -- seconds }, apnsConfig = defaultAPNSPushClientConfig, + wpConfig = WebPushConfig {vapidKey}, subsBatchSize = 900, inactiveClientExpiration = settingIsOn "INACTIVE_CLIENTS" "disconnect" ini @@ -294,6 +299,7 @@ ntfServerCLI cfgPath logPath = putStrLn $ "Error: both " <> storeLogFilePath <> " file and " <> B.unpack schema <> " schema are present (database: " <> B.unpack connstr <> ")." putStrLn "Configure notification server storage." exitFailure + vapidKeyPath = combine cfgPath "vapid.privkey" printNtfServerConfig :: [(ServiceName, ASrvTransport, AddHTTP)] -> PostgresStoreCfg -> IO () printNtfServerConfig transports PostgresStoreCfg {dbOpts = DBOpts {connstr, schema}, dbStoreLogPath} = do @@ -395,3 +401,19 @@ cliCommandP cfgPath logPath iniFile = <> metavar "FQDN" ) pure InitOptions {enableStoreLog, dbOptions, signAlgorithm, ip, fqdn} + +genVapidKey :: FilePath -> IO VapidKey +genVapidKey file = do + cfgExists <- doesFileExist file + unless cfgExists $ run $ "openssl ecparam -name prime256v1 -genkey -noout -out " <> file + key <- C.readECPrivateKey file + pure $ mkVapid key + where + run cmd = void $ readCreateProcess (shell cmd) "" + +getVapidKey :: FilePath -> IO VapidKey +getVapidKey file = do + cfgExists <- doesFileExist file + unless cfgExists $ error $ "VAPID key not found: " <> file + key <- C.readECPrivateKey file + pure $ mkVapid key diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index c729cecc2..959eb3fd6 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -32,6 +32,26 @@ import qualified Crypto.Cipher.Types as CT import qualified Crypto.MAC.HMAC as HMAC import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Data.ByteString.Base64.URL as B64 + +-- | Vapid +-- | fp: fingerprint, base64url encoded without padding +-- | key: privkey +data VapidKey = VapidKey + { key::ECDSA.PrivateKey, + fp::B.ByteString + } + deriving (Eq, Show) + +mkVapid :: ECDSA.PrivateKey -> VapidKey +mkVapid key = VapidKey { key, fp } + where + fp = B64.encodeUnpadded . B.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) . ECDSA.private_d $ key + +data WebPushConfig = WebPushConfig + { vapidKey :: VapidKey + } wpPushProviderClient :: Manager -> PushProviderClient wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 0912e29b2..5b495c783 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -205,8 +205,9 @@ checkNtfToken c = A.checkNtfToken c NRMInteractive verifyNtfToken :: AgentClient -> DeviceToken -> C.CbNonce -> ByteString -> AE () verifyNtfToken c = A.verifyNtfToken c NRMInteractive -runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO () -runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do +runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> IO NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO () +runNtfTestCfg (t, msType) baseId smpCfg ntfCfg' aCfg bCfg runTest = do + ntfCfg <- ntfCfg' ASSCfg qt mt serverStoreCfg <- pure $ testServerStoreConfig msType let smpCfg' = withServerCfg smpCfg $ \cfg_ -> ASrvCfg qt mt cfg_ {serverStoreCfg} withSmpServerConfigOn t smpCfg' testPort $ \_ -> @@ -931,7 +932,8 @@ testMigrateToServiceSubscriptions :: HasCallStack => (ASrvTransport, AStoreType) testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> do (c1, c2, c3) <- withSmpServerConfigOn t cfgNoService testPort $ \_ -> do (c1, c2) <- withAPNSMockServer $ \apns -> do - withNtfServerCfg ntfCfgNoService $ \_ -> runRight $ do + cfg' <- ntfCfgNoService + withNtfServerCfg cfg' $ \_ -> runRight $ do _tkn <- registerTestToken a "abcd" NMInstant apns -- create 2 connections with ntfs, test delivery c1 <- testConnectMsg apns a b "hello" @@ -970,27 +972,31 @@ testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> d serverDOWN a b 5 -- Ntf server does not use server, subscriptions downgrade - c6 <- withAPNSMockServer $ \apns -> withSmpServer ps $ withNtfServerCfg ntfCfgNoService $ \_ -> do - serverUP a b 5 - runRight $ do - testSendMsg apns a b c1 "msg 1" - testSendMsg apns a b c2 "msg 2" - testSendMsg apns a b c3 "msg 3" - testSendMsg apns a b c4 "msg 4" - testSendMsg apns a b c5 "msg 5" - testConnectMsg apns a b "msg 6" + c6 <- withAPNSMockServer $ \apns -> do + cfg' <- ntfCfgNoService + withSmpServer ps $ withNtfServerCfg cfg' $ \_ -> do + serverUP a b 5 + runRight $ do + testSendMsg apns a b c1 "msg 1" + testSendMsg apns a b c2 "msg 2" + testSendMsg apns a b c3 "msg 3" + testSendMsg apns a b c4 "msg 4" + testSendMsg apns a b c5 "msg 5" + testConnectMsg apns a b "msg 6" serverDOWN a b 6 - withAPNSMockServer $ \apns -> withSmpServerConfigOn t cfgNoService testPort $ \_ -> withNtfServerCfg ntfCfgNoService $ \_ -> do - serverUP a b 6 - runRight_ $ do - testSendMsg apns a b c1 "1" - testSendMsg apns a b c2 "2" - testSendMsg apns a b c3 "3" - testSendMsg apns a b c4 "4" - testSendMsg apns a b c5 "5" - testSendMsg apns a b c6 "6" - void $ testConnectMsg apns a b "7" + withAPNSMockServer $ \apns -> do + cfg' <- ntfCfgNoService + withSmpServerConfigOn t cfgNoService testPort $ \_ -> withNtfServerCfg cfg' $ \_ -> do + serverUP a b 6 + runRight_ $ do + testSendMsg apns a b c1 "1" + testSendMsg apns a b c2 "2" + testSendMsg apns a b c3 "3" + testSendMsg apns a b c4 "4" + testSendMsg apns a b c5 "5" + testSendMsg apns a b c6 "6" + void $ testConnectMsg apns a b "7" serverDOWN a b 7 where testConnectMsg apns a b msg = do @@ -1013,7 +1019,9 @@ testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> d cfgNoService = updateCfg (cfgMS msType) $ \(cfg' :: ServerConfig s) -> let ServerConfig {transportConfig} = cfg' in cfg' {transportConfig = transportConfig {askClientCert = False}} :: ServerConfig s - ntfCfgNoService = ntfServerCfg {useServiceCreds = False, transports = [(ntfTestPort, t, False)]} + ntfCfgNoService = do + cfg' <- ntfServerCfg + pure cfg' {useServiceCreds = False, transports = [(ntfTestPort, t, False)]} testMessage_ :: HasCallStack => APNSMockServer -> AgentClient -> ConnId -> AgentClient -> ConnId -> SMP.MsgBody -> ExceptT AgentErrorType IO () testMessage_ apns a aId b bId msg = do diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index bdd57f61c..275d0bab0 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -61,6 +61,8 @@ import UnliftIO.Concurrent import qualified UnliftIO.Exception as E import UnliftIO.STM import Control.Exception (throwIO) +import Simplex.Messaging.Notifications.Server.Push.WebPush (WebPushConfig(..)) +import Simplex.Messaging.Notifications.Server.Main (getVapidKey) testHost :: NonEmpty TransportHost testHost = "localhost" @@ -125,9 +127,10 @@ testNtfClient client = do Right th -> client th Left e -> error $ show e -ntfServerCfg :: NtfServerConfig -ntfServerCfg = - NtfServerConfig +ntfServerCfg :: IO NtfServerConfig +ntfServerCfg = do + vapidKey <- getVapidKey "tests/fixtures/vapid.privkey" + pure NtfServerConfig { transports = [], controlPort = Nothing, controlPortUserAuth = Nothing, @@ -142,6 +145,7 @@ ntfServerCfg = { apnsPort = apnsTestPort, caStoreFile = "tests/fixtures/ca.crt" }, + wpConfig = WebPushConfig {vapidKey}, subsBatchSize = 900, inactiveClientExpiration = Just defaultInactiveClientExpiration, dbStoreConfig = ntfTestDBCfg, @@ -160,20 +164,24 @@ ntfServerCfg = startOptions = defaultStartOptions } -ntfServerCfgVPrev :: NtfServerConfig -ntfServerCfgVPrev = - ntfServerCfg - { ntfServerVRange = prevRange $ ntfServerVRange ntfServerCfg, +ntfServerCfgVPrev :: IO NtfServerConfig +ntfServerCfgVPrev = ntfServerCfg >>= + \cfg -> pure $ ntfServerCfgVPrev' cfg + +ntfServerCfgVPrev' :: NtfServerConfig -> NtfServerConfig +ntfServerCfgVPrev' cfg = + cfg + { ntfServerVRange = prevRange $ ntfServerVRange cfg, smpAgentCfg = smpAgentCfg' {smpCfg = smpCfg' {serverVRange = prevRange serverVRange'}} } where - smpAgentCfg' = smpAgentCfg ntfServerCfg + smpAgentCfg' = smpAgentCfg cfg smpCfg' = smpCfg smpAgentCfg' serverVRange' = serverVRange smpCfg' withNtfServerThreadOn :: HasCallStack => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => ThreadId -> IO a) -> IO a -withNtfServerThreadOn t port' dbStoreConfig = - withNtfServerCfg ntfServerCfg {transports = [(port', t, False)], dbStoreConfig} +withNtfServerThreadOn t port' dbStoreConfig a = ntfServerCfg >>= \cfg -> + withNtfServerCfg cfg {transports = [(port', t, False)], dbStoreConfig} a withNtfServerCfg :: HasCallStack => NtfServerConfig -> (ThreadId -> IO a) -> IO a withNtfServerCfg cfg@NtfServerConfig {transports} = diff --git a/tests/fixtures/vapid.privkey b/tests/fixtures/vapid.privkey new file mode 100644 index 000000000..294260c2d --- /dev/null +++ b/tests/fixtures/vapid.privkey @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIMTAncBq2I7G3KvW4C8Y8Heg2cbcDTobbGFQFnBiA5M/oAoGCCqGSM49 +AwEHoUQDQgAEiTsBKQSvUDWslEZcwqLvu0AaPd1Gi5KBl1bpLml57treHt+S93Q5 +hCLHLjKPflQVm3yF31PABCLJsMr8ckvAkA== +-----END EC PRIVATE KEY-----