comments

* xftp server: log file reception error

* report HTTP2 error as timeout error

* reduce timeout to 5 min

* process timeout error in protocol response

* log warning on timeout/HTTP2 error

CHANGELOG.md

@@ -1,3 +1,39 @@
+# 5.8.0
+
+Version 5.8.0.10
+
+SMP server and client:
+- protocol extension to forward messages to the destination servers, to protect sending client IP address and transport session.
+
+Agent:
+- process timed out subscription responses to reduce the number of resubscriptions.
+- avoid sending messages and commands when waiting for response timed out (except batched SUB and DEL commands).
+- fix issue with stuck message reception on slow connection (when response to ACK timed out, and the new message was not processed until resubscribed).
+- fix issue when temporary file sending or receiving error was treated as permanent.
+
+SMP server:
+- include OK responses to all batched SUB requests to reduce subscription timeouts.
+
+XFTP server:
+- report file upload timeout as TIMEOUT, to avoid delivery failure.
+
+# 5.7.6
+
+XFTP agent:
+- treat XFTP handshake timeouts and network errors as temporary, to retry file operations.
+
+# 5.7.5
+
+SMP agent:
+- fail if non-unique connection IDs are passed to sendMessages (to prevent client errors and deadlocks).
+
+# 5.7.4
+
+SMP agent:
+- remove re-subscription timeouts (as they are tracked per operation, and could cause failed subscriptions).
+- reconnect XFTP clients when network settings changes.
+- fix lock contention resulting in stuck subscriptions on network change.
+
 # 5.7.3
 
 SMP/NTF protocol:

apps/smp-server/Main.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE LambdaCase #-}
-
 module Main where
 
 import Control.Logger.Simple
 import Simplex.Messaging.Server.CLI (getEnvPath)
 import Simplex.Messaging.Server.Main
+import qualified Static
 
 defaultCfgPath :: FilePath
 defaultCfgPath = "/etc/opt/simplex"
@@ -20,4 +19,4 @@ main = do
   setLogLevel LogDebug
   cfgPath <- getEnvPath "SMP_SERVER_CFG_PATH" defaultCfgPath
   logPath <- getEnvPath "SMP_SERVER_LOG_PATH" defaultLogPath
-  withGlobalLogging logCfg $ smpServerCLI cfgPath logPath
+  withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles cfgPath logPath

apps/smp-server/static/contact/index.html

@@ -0,0 +1 @@
+../link.html

apps/smp-server/static/invitation/index.html

@@ -0,0 +1 @@
+../link.html

apps/smp-server/static/media/apple_store.svg

@@ -0,0 +1,26 @@
+<svg width="119" height="40" viewBox="0 0 119 40" fill="none" xmlns="http://www.w3.org/2000/svg">
+<path d="M8.44484 39.125C8.14016 39.125 7.84284 39.1211 7.54055 39.1143C6.91433 39.1061 6.28957 39.0516 5.67141 38.9512C5.095 38.8519 4.53661 38.6673 4.01467 38.4033C3.49751 38.1415 3.02582 37.7983 2.61767 37.3867C2.20361 36.98 1.85888 36.5082 1.59716 35.9902C1.33255 35.4688 1.14942 34.9099 1.05416 34.333C0.951281 33.7131 0.895621 33.0863 0.887656 32.458C0.881316 32.2471 0.873016 31.5449 0.873016 31.5449V8.44434C0.873016 8.44434 0.881856 7.75293 0.887706 7.5498C0.895332 6.92248 0.950669 6.29665 1.05324 5.67773C1.14868 5.09925 1.33194 4.53875 1.5967 4.01563C1.85746 3.49794 2.20027 3.02586 2.61184 2.61768C3.02294 2.20562 3.49614 1.8606 4.01418 1.59521C4.53492 1.33209 5.09225 1.14873 5.6675 1.05127C6.28769 0.949836 6.91462 0.894996 7.54301 0.88721L8.44533 0.875H111.214L112.127 0.8877C112.75 0.895099 113.371 0.94945 113.985 1.05029C114.566 1.14898 115.13 1.33362 115.656 1.59814C116.694 2.13299 117.539 2.97916 118.071 4.01807C118.332 4.53758 118.512 5.09351 118.606 5.66699C118.71 6.29099 118.768 6.92174 118.78 7.5542C118.783 7.8374 118.783 8.1416 118.783 8.44434C118.791 8.81934 118.791 9.17627 118.791 9.53613V30.4648C118.791 30.8281 118.791 31.1826 118.783 31.54C118.783 31.8652 118.783 32.1631 118.779 32.4697C118.768 33.0909 118.71 33.7104 118.608 34.3232C118.515 34.9043 118.333 35.4675 118.068 35.9932C117.805 36.5056 117.462 36.9733 117.053 37.3789C116.644 37.7927 116.172 38.1379 115.653 38.4014C115.128 38.6674 114.566 38.8527 113.985 38.9512C113.367 39.0522 112.742 39.1067 112.116 39.1143C111.823 39.1211 111.517 39.125 111.219 39.125L110.135 39.127L8.44484 39.125Z" fill="black"/>
+<path d="M24.7689 20.3007C24.7796 19.466 25.0013 18.6477 25.4134 17.9217C25.8254 17.1957 26.4144 16.5858 27.1254 16.1486C26.6737 15.5035 26.0778 14.9725 25.3849 14.598C24.6921 14.2234 23.9215 14.0156 23.1343 13.991C21.455 13.8147 19.8271 14.9958 18.9714 14.9958C18.0991 14.9958 16.7816 14.0085 15.3629 14.0376C14.4452 14.0673 13.5509 14.3341 12.767 14.8122C11.9831 15.2903 11.3364 15.9632 10.89 16.7655C8.95597 20.1139 10.3986 25.035 12.2512 27.7416C13.1781 29.0669 14.2613 30.5474 15.6788 30.4949C17.0659 30.4374 17.5839 29.6104 19.2582 29.6104C20.917 29.6104 21.403 30.4949 22.8492 30.4615C24.3376 30.4374 25.2753 29.1303 26.1697 27.7924C26.8357 26.848 27.3481 25.8043 27.6881 24.6999C26.8234 24.3341 26.0855 23.722 25.5664 22.9397C25.0473 22.1574 24.7699 21.2396 24.7689 20.3007V20.3007Z" fill="white"/>
+<path d="M22.0373 12.2109C22.8488 11.2367 23.2486 9.98451 23.1518 8.72028C21.9119 8.8505 20.7667 9.44306 19.9442 10.3799C19.5421 10.8376 19.2341 11.37 19.0378 11.9468C18.8416 12.5235 18.7609 13.1333 18.8005 13.7413C19.4206 13.7477 20.0341 13.6132 20.5948 13.3482C21.1555 13.0831 21.6487 12.6942 22.0373 12.2109Z" fill="white"/>
+<path d="M42.3023 27.1396H37.5689L36.4322 30.4961H34.4273L38.9107 18.0781H40.9937L45.4771 30.4961H43.438L42.3023 27.1396ZM38.0591 25.5908H41.8111L39.9615 20.1435H39.9097L38.0591 25.5908Z" fill="white"/>
+<path d="M55.1597 25.9697C55.1597 28.7832 53.6538 30.5908 51.3814 30.5908C50.8057 30.6209 50.2332 30.4883 49.7294 30.2082C49.2256 29.928 48.8109 29.5117 48.5327 29.0068H48.4897V33.4912H46.6313V21.4424H48.4302V22.9482H48.4644C48.7553 22.4458 49.1771 22.0316 49.6847 21.7497C50.1923 21.4679 50.7669 21.3289 51.3472 21.3476C53.645 21.3477 55.1597 23.1641 55.1597 25.9697ZM53.2495 25.9697C53.2495 24.1367 52.3023 22.9316 50.857 22.9316C49.437 22.9316 48.482 24.1621 48.482 25.9697C48.482 27.7939 49.437 29.0156 50.857 29.0156C52.3023 29.0156 53.2495 27.8193 53.2495 25.9697Z" fill="white"/>
+<path d="M65.1245 25.9697C65.1245 28.7832 63.6187 30.5908 61.3462 30.5908C60.7706 30.6209 60.1981 30.4883 59.6943 30.2082C59.1905 29.928 58.7758 29.5117 58.4976 29.0068H58.4546V33.4912H56.5962V21.4424H58.395V22.9482H58.4292C58.7201 22.4458 59.1419 22.0316 59.6495 21.7497C60.1571 21.4679 60.7317 21.3289 61.312 21.3476C63.6099 21.3476 65.1245 23.164 65.1245 25.9697ZM63.2144 25.9697C63.2144 24.1367 62.2671 22.9316 60.8218 22.9316C59.4019 22.9316 58.4468 24.1621 58.4468 25.9697C58.4468 27.7939 59.4019 29.0156 60.8218 29.0156C62.2671 29.0156 63.2144 27.8193 63.2144 25.9697H63.2144Z" fill="white"/>
+<path d="M71.7105 27.0361C71.8482 28.2676 73.0445 29.0761 74.6792 29.0761C76.2456 29.0761 77.3726 28.2675 77.3726 27.1572C77.3726 26.1933 76.6929 25.6162 75.0835 25.2207L73.4742 24.833C71.1939 24.2822 70.1353 23.2158 70.1353 21.4853C70.1353 19.3427 72.0025 17.871 74.6538 17.871C77.2778 17.871 79.0767 19.3427 79.1372 21.4853H77.2612C77.1489 20.246 76.1245 19.498 74.6274 19.498C73.1304 19.498 72.106 20.2548 72.106 21.3564C72.106 22.2343 72.7603 22.7509 74.3608 23.1464L75.729 23.4823C78.2769 24.0849 79.3355 25.1083 79.3355 26.9247C79.3355 29.248 77.4849 30.703 74.5415 30.703C71.7876 30.703 69.9282 29.2821 69.8081 27.036L71.7105 27.0361Z" fill="white"/>
+<path d="M83.3462 19.2998V21.4424H85.0679V22.9141H83.3462V27.9053C83.3462 28.6807 83.6909 29.042 84.4478 29.042C84.6522 29.0384 84.8562 29.0241 85.0591 28.999V30.4619C84.7188 30.5255 84.373 30.5543 84.0269 30.5478C82.1939 30.5478 81.479 29.8593 81.479 28.1035V22.9141H80.1626V21.4424H81.479V19.2998H83.3462Z" fill="white"/>
+<path d="M86.065 25.9697C86.065 23.1211 87.7427 21.3311 90.3589 21.3311C92.9839 21.3311 94.6539 23.1211 94.6539 25.9697C94.6539 28.8262 92.9927 30.6084 90.3589 30.6084C87.7261 30.6084 86.065 28.8262 86.065 25.9697ZM92.7603 25.9697C92.7603 24.0156 91.8648 22.8623 90.3589 22.8623C88.8531 22.8623 87.9585 24.0244 87.9585 25.9697C87.9585 27.9316 88.8531 29.0762 90.3589 29.0762C91.8648 29.0762 92.7603 27.9316 92.7603 25.9697H92.7603Z" fill="white"/>
+<path d="M96.1861 21.4424H97.9585V22.9834H98.0015C98.1215 22.5021 98.4034 22.0768 98.8 21.7789C99.1966 21.481 99.6836 21.3287 100.179 21.3476C100.393 21.3469 100.607 21.3702 100.816 21.417V23.1553C100.546 23.0726 100.264 23.0347 99.981 23.043C99.711 23.032 99.4419 23.0796 99.192 23.1825C98.9422 23.2854 98.7176 23.4411 98.5336 23.639C98.3496 23.8369 98.2106 24.0723 98.1262 24.3289C98.0418 24.5856 98.0139 24.8575 98.0445 25.126V30.4961H96.1861L96.1861 21.4424Z" fill="white"/>
+<path d="M109.384 27.8369C109.134 29.4805 107.534 30.6084 105.486 30.6084C102.852 30.6084 101.217 28.8437 101.217 26.0127C101.217 23.1729 102.861 21.3311 105.408 21.3311C107.913 21.3311 109.488 23.0518 109.488 25.7969V26.4336H103.093V26.5459C103.064 26.8791 103.105 27.2148 103.216 27.5306C103.326 27.8464 103.502 28.1352 103.732 28.3778C103.963 28.6203 104.242 28.8111 104.552 28.9374C104.861 29.0637 105.195 29.1226 105.529 29.1103C105.968 29.1515 106.409 29.0498 106.785 28.8203C107.162 28.5909 107.455 28.246 107.62 27.8369L109.384 27.8369ZM103.102 25.1348H107.628C107.645 24.8352 107.6 24.5354 107.495 24.2541C107.39 23.9729 107.229 23.7164 107.02 23.5006C106.812 23.2849 106.561 23.1145 106.283 23.0003C106.006 22.8861 105.708 22.8305 105.408 22.8369C105.105 22.8351 104.805 22.8933 104.525 23.008C104.245 23.1227 103.99 23.2918 103.776 23.5054C103.562 23.7191 103.392 23.973 103.276 24.2527C103.16 24.5323 103.101 24.8321 103.102 25.1348V25.1348Z" fill="white"/>
+<path d="M37.8262 8.73101C38.2158 8.70305 38.6068 8.76191 38.9709 8.90335C39.335 9.04478 39.6632 9.26526 39.9318 9.54889C40.2004 9.83251 40.4026 10.1722 40.524 10.5435C40.6455 10.9148 40.6829 11.3083 40.6338 11.6959C40.6338 13.6021 39.6035 14.6979 37.8262 14.6979H35.6709V8.73101H37.8262ZM36.5977 13.854H37.7227C38.0011 13.8707 38.2797 13.825 38.5382 13.7204C38.7968 13.6158 39.0287 13.4548 39.2172 13.2493C39.4057 13.0437 39.546 12.7987 39.6279 12.5321C39.7097 12.2655 39.7311 11.9839 39.6904 11.708C39.7282 11.4332 39.7046 11.1534 39.6215 10.8887C39.5384 10.6241 39.3977 10.3811 39.2097 10.1771C39.0216 9.97322 38.7908 9.81341 38.5337 9.70917C38.2766 9.60494 37.9997 9.55885 37.7227 9.57422H36.5977V13.854Z" fill="white"/>
+<path d="M41.6807 12.4443C41.6524 12.1484 41.6862 11.8499 41.7801 11.5678C41.8739 11.2857 42.0257 11.0264 42.2256 10.8064C42.4255 10.5864 42.6693 10.4107 42.9411 10.2904C43.213 10.1701 43.507 10.108 43.8042 10.108C44.1015 10.108 44.3955 10.1701 44.6673 10.2904C44.9392 10.4107 45.1829 10.5864 45.3828 10.8064C45.5828 11.0264 45.7345 11.2857 45.8284 11.5678C45.9222 11.8499 45.9561 12.1484 45.9278 12.4443C45.9566 12.7406 45.9232 13.0396 45.8296 13.3221C45.736 13.6046 45.5843 13.8644 45.3843 14.0848C45.1843 14.3052 44.9404 14.4814 44.6683 14.6019C44.3962 14.7225 44.1018 14.7847 43.8042 14.7847C43.5066 14.7847 43.2123 14.7225 42.9401 14.6019C42.668 14.4814 42.4241 14.3052 42.2241 14.0848C42.0241 13.8644 41.8725 13.6046 41.7789 13.3221C41.6853 13.0396 41.6518 12.7406 41.6807 12.4443V12.4443ZM45.0137 12.4443C45.0137 11.4683 44.5752 10.8975 43.8057 10.8975C43.0332 10.8975 42.5987 11.4683 42.5987 12.4444C42.5987 13.4282 43.0333 13.9946 43.8057 13.9946C44.5752 13.9946 45.0137 13.4243 45.0137 12.4443H45.0137Z" fill="white"/>
+<path d="M51.5733 14.6978H50.6514L49.7207 11.3813H49.6504L48.7237 14.6978H47.8106L46.5694 10.1948H47.4707L48.2774 13.6308H48.3438L49.2696 10.1948H50.1221L51.0479 13.6308H51.1182L51.9209 10.1948H52.8096L51.5733 14.6978Z" fill="white"/>
+<path d="M53.8536 10.1948H54.709V10.9102H54.7754C54.8881 10.6532 55.0781 10.4379 55.319 10.2941C55.5598 10.1503 55.8396 10.0852 56.1192 10.1079C56.3383 10.0914 56.5583 10.1245 56.7629 10.2046C56.9675 10.2847 57.1514 10.4098 57.3011 10.5706C57.4508 10.7315 57.5624 10.9239 57.6276 11.1337C57.6928 11.3436 57.7099 11.5654 57.6778 11.7827V14.6977H56.7891V12.0059C56.7891 11.2822 56.4746 10.9224 55.8174 10.9224C55.6687 10.9154 55.5202 10.9408 55.3821 10.9966C55.244 11.0524 55.1197 11.1375 55.0176 11.2458C54.9154 11.3542 54.838 11.4834 54.7904 11.6245C54.7429 11.7657 54.7265 11.9154 54.7422 12.0635V14.6978H53.8535L53.8536 10.1948Z" fill="white"/>
+<path d="M59.0938 8.43701H59.9825V14.6978H59.0938V8.43701Z" fill="white"/>
+<path d="M61.2178 12.4443C61.1895 12.1484 61.2234 11.8498 61.3172 11.5677C61.4111 11.2857 61.5629 11.0263 61.7629 10.8063C61.9628 10.5863 62.2065 10.4106 62.4784 10.2903C62.7503 10.17 63.0443 10.1079 63.3416 10.1079C63.6389 10.1079 63.9329 10.17 64.2047 10.2903C64.4766 10.4106 64.7203 10.5863 64.9203 10.8063C65.1203 11.0263 65.272 11.2857 65.3659 11.5677C65.4598 11.8498 65.4936 12.1484 65.4654 12.4443C65.4942 12.7406 65.4607 13.0396 65.3671 13.3221C65.2734 13.6046 65.1218 13.8644 64.9217 14.0848C64.7217 14.3052 64.4778 14.4814 64.2057 14.6019C63.9335 14.7224 63.6392 14.7847 63.3416 14.7847C63.044 14.7847 62.7496 14.7224 62.4775 14.6019C62.2053 14.4814 61.9614 14.3052 61.7614 14.0848C61.5614 13.8644 61.4097 13.6046 61.3161 13.3221C61.2225 13.0396 61.189 12.7406 61.2178 12.4443V12.4443ZM64.5508 12.4443C64.5508 11.4683 64.1123 10.8975 63.3428 10.8975C62.5703 10.8975 62.1358 11.4683 62.1358 12.4444C62.1358 13.4282 62.5704 13.9946 63.3428 13.9946C64.1123 13.9946 64.5508 13.4243 64.5508 12.4443H64.5508Z" fill="white"/>
+<path d="M66.4009 13.4243C66.4009 12.6138 67.0044 12.1465 68.0757 12.0801L69.2954 12.0098V11.6211C69.2954 11.1455 68.981 10.877 68.3736 10.877C67.8775 10.877 67.5337 11.0591 67.4351 11.3775H66.5747C66.6656 10.604 67.3931 10.1079 68.4146 10.1079C69.5435 10.1079 70.1802 10.6699 70.1802 11.6211V14.6978H69.3247V14.065H69.2544C69.1117 14.292 68.9113 14.477 68.6737 14.6012C68.4361 14.7254 68.1697 14.7844 67.9019 14.772C67.7129 14.7916 67.5218 14.7715 67.341 14.7128C67.1603 14.6541 66.9938 14.5581 66.8524 14.4312C66.711 14.3042 66.5977 14.149 66.52 13.9756C66.4422 13.8022 66.4017 13.6144 66.4009 13.4243V13.4243ZM69.2954 13.0396V12.6631L68.1958 12.7334C67.5757 12.7749 67.2945 12.9859 67.2945 13.3828C67.2945 13.7881 67.646 14.0239 68.1295 14.0239C68.2711 14.0383 68.4142 14.024 68.5502 13.9819C68.6862 13.9398 68.8123 13.8708 68.9211 13.7789C69.0299 13.6871 69.1191 13.5743 69.1834 13.4473C69.2477 13.3203 69.2858 13.1816 69.2954 13.0396V13.0396Z" fill="white"/>
+<path d="M71.3482 12.4444C71.3482 11.0215 72.0796 10.1201 73.2173 10.1201C73.4987 10.1072 73.778 10.1746 74.0226 10.3145C74.2671 10.4544 74.4667 10.661 74.5982 10.9101H74.6646V8.43701H75.5533V14.6978H74.7017V13.9863H74.6314C74.4898 14.2338 74.2832 14.4378 74.0339 14.5763C73.7847 14.7148 73.5023 14.7825 73.2173 14.772C72.0718 14.772 71.3482 13.8706 71.3482 12.4444ZM72.2662 12.4444C72.2662 13.3994 72.7164 13.9741 73.4693 13.9741C74.2183 13.9741 74.6812 13.3911 74.6812 12.4483C74.6812 11.5098 74.2134 10.9185 73.4693 10.9185C72.7212 10.9185 72.2661 11.4971 72.2661 12.4444H72.2662Z" fill="white"/>
+<path d="M79.23 12.4443C79.2017 12.1484 79.2356 11.8499 79.3294 11.5678C79.4232 11.2857 79.575 11.0264 79.7749 10.8064C79.9749 10.5864 80.2186 10.4107 80.4904 10.2904C80.7623 10.1701 81.0563 10.108 81.3536 10.108C81.6508 10.108 81.9448 10.1701 82.2167 10.2904C82.4885 10.4107 82.7322 10.5864 82.9322 10.8064C83.1321 11.0264 83.2839 11.2857 83.3777 11.5678C83.4715 11.8499 83.5054 12.1484 83.4771 12.4443C83.5059 12.7406 83.4725 13.0396 83.3789 13.3221C83.2853 13.6046 83.1336 13.8644 82.9336 14.0848C82.7336 14.3052 82.4897 14.4814 82.2176 14.6019C81.9455 14.7225 81.6512 14.7847 81.3536 14.7847C81.0559 14.7847 80.7616 14.7225 80.4895 14.6019C80.2173 14.4814 79.9735 14.3052 79.7735 14.0848C79.5735 13.8644 79.4218 13.6046 79.3282 13.3221C79.2346 13.0396 79.2012 12.7406 79.23 12.4443V12.4443ZM82.563 12.4443C82.563 11.4683 82.1245 10.8975 81.355 10.8975C80.5826 10.8975 80.148 11.4683 80.148 12.4444C80.148 13.4282 80.5826 13.9946 81.355 13.9946C82.1245 13.9946 82.563 13.4243 82.563 12.4443Z" fill="white"/>
+<path d="M84.6695 10.1948H85.5249V10.9102H85.5913C85.704 10.6532 85.894 10.4379 86.1349 10.2941C86.3757 10.1503 86.6555 10.0852 86.9351 10.1079C87.1542 10.0914 87.3742 10.1245 87.5788 10.2046C87.7834 10.2847 87.9673 10.4098 88.117 10.5706C88.2667 10.7315 88.3783 10.9239 88.4435 11.1337C88.5087 11.3436 88.5258 11.5654 88.4937 11.7827V14.6977H87.605V12.0059C87.605 11.2822 87.2906 10.9224 86.6333 10.9224C86.4846 10.9154 86.3361 10.9408 86.198 10.9966C86.06 11.0524 85.9356 11.1375 85.8335 11.2458C85.7314 11.3542 85.6539 11.4834 85.6064 11.6245C85.5588 11.7657 85.5424 11.9154 85.5581 12.0635V14.6978H84.6695V10.1948Z" fill="white"/>
+<path d="M93.5152 9.07373V10.2153H94.4908V10.9639H93.5152V13.2793C93.5152 13.751 93.7095 13.9575 94.1519 13.9575C94.2651 13.9572 94.3783 13.9503 94.4908 13.937V14.6772C94.3312 14.7058 94.1695 14.721 94.0074 14.7226C93.0191 14.7226 92.6255 14.375 92.6255 13.5068V10.9638H91.9107V10.2153H92.6255V9.07373H93.5152Z" fill="white"/>
+<path d="M95.7046 8.43701H96.5855V10.9185H96.6558C96.7739 10.6591 96.9691 10.4425 97.2148 10.2982C97.4605 10.1539 97.7448 10.0888 98.0288 10.1118C98.2467 10.1 98.4646 10.1364 98.6669 10.2184C98.8692 10.3004 99.0509 10.4261 99.199 10.5864C99.3471 10.7468 99.458 10.9378 99.5238 11.146C99.5896 11.3541 99.6086 11.5742 99.5796 11.7905V14.6978H98.69V12.0098C98.69 11.2905 98.355 10.9263 97.7271 10.9263C97.5744 10.9137 97.4207 10.9347 97.277 10.9878C97.1332 11.0408 97.0027 11.1247 96.8948 11.2334C96.7868 11.3421 96.7038 11.4732 96.6518 11.6173C96.5997 11.7614 96.5798 11.9152 96.5933 12.0679V14.6977H95.7047L95.7046 8.43701Z" fill="white"/>
+<path d="M104.761 13.4819C104.641 13.8935 104.379 14.2495 104.022 14.4876C103.666 14.7258 103.236 14.8309 102.81 14.7847C102.513 14.7925 102.219 14.7357 101.946 14.6182C101.674 14.5006 101.43 14.3252 101.232 14.1041C101.034 13.8829 100.887 13.6214 100.8 13.3376C100.713 13.0537 100.689 12.7544 100.73 12.4605C100.691 12.1656 100.715 11.8656 100.801 11.581C100.888 11.2963 101.034 11.0335 101.231 10.8105C101.428 10.5874 101.671 10.4092 101.942 10.288C102.214 10.1668 102.509 10.1054 102.806 10.1079C104.059 10.1079 104.815 10.9639 104.815 12.3779V12.688H101.635V12.7378C101.621 12.9031 101.642 13.0694 101.696 13.2261C101.75 13.3829 101.837 13.5266 101.95 13.6481C102.062 13.7695 102.2 13.866 102.352 13.9314C102.504 13.9968 102.669 14.0297 102.835 14.0278C103.047 14.0533 103.262 14.0151 103.453 13.9178C103.644 13.8206 103.802 13.6689 103.906 13.4819L104.761 13.4819ZM101.635 12.0308H103.91C103.921 11.8796 103.9 11.7278 103.849 11.5851C103.798 11.4424 103.718 11.3119 103.614 11.2021C103.509 11.0922 103.383 11.0054 103.243 10.9472C103.103 10.8891 102.953 10.8608 102.801 10.8643C102.648 10.8623 102.495 10.8912 102.353 10.9491C102.21 11.0071 102.081 11.0929 101.972 11.2017C101.864 11.3104 101.778 11.4397 101.72 11.5821C101.662 11.7245 101.633 11.8771 101.635 12.0308H101.635Z" fill="white"/>
+</svg>

apps/smp-server/static/media/contact.js

@@ -0,0 +1,66 @@
+(function () {
+
+  let complete = false
+  run()
+  window.onload = run
+
+  async function run() {
+    const connURIel = document.getElementById("conn_req_uri_text");
+    const mobileConnURIanchor = document.getElementById("mobile_conn_req_uri");
+    const connQRCodes = document.getElementsByClassName("conn_req_uri_qrcode");
+    console.log(connQRCodes);
+    if (complete || !connURIel || !mobileConnURIanchor || connQRCodes < 2) return
+    complete = true
+    let connURI = document.location.toString()
+    const parsedURI = new URL(connURI)
+    const path = parsedURI.pathname.split("/")
+    const len = path.length
+    const action = path[len - (path[len - 1] == "" ? 2 : 1)]
+    parsedURI.protocol = "https"
+    parsedURI.pathname = "/" + action
+    connURI = parsedURI.toString()
+    console.log("connection URI: ", connURI)
+    mobileConnURIanchor.href = "simplex:" + parsedURI.pathname + parsedURI.hash
+    connURIel.innerText = "/c " + connURI
+    for (const connQRCode of connQRCodes) {
+      try {
+        await QRCode.toCanvas(connQRCode, connURI, {
+          errorCorrectionLevel: "M",
+          color: {dark: "#062D56"}
+        });
+        connQRCode.style.width = "320px";
+        connQRCode.style.height = "320px";
+      } catch (err) {
+        console.error(err);
+      }
+    }
+
+    function contentCopyWithTooltip(parent) {
+      const content = parent.querySelector(".content");
+      const tooltip = parent.querySelector(".tooltiptext");
+      console.log(parent.querySelector(".content_copy"), 111)
+      console.log(parent)
+      const copyButton = parent.querySelector(".content_copy");
+      copyButton.addEventListener("click", copyAddress)
+      copyButton.addEventListener("mouseout", resetTooltip)
+
+      function copyAddress() {
+        navigator.clipboard.writeText(content.innerText || content.value);
+        tooltip.innerHTML = "Copied!";
+      }
+
+      function resetTooltip() {
+        tooltip.innerHTML = "Copy to clipboard";
+      }
+    }
+
+    function copyAddress() {
+      navigator.clipboard.writeText(connURI);
+      tooltipEl.innerHTML = "Copied!";
+    }
+
+    function resetTooltip() {
+      tooltipEl.innerHTML = "Copy to clipboard";
+    }
+  }
+})();

apps/smp-server/static/media/f_droid.svg

@@ -0,0 +1,372 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<svg
+   width="560"
+   height="164"
+   version="1.1"
+   id="svg1048"
+   sodipodi:docname="f_droid.svg"
+   inkscape:version="1.1.2 (0a00cf5339, 2022-02-04, custom)"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns:xlink="http://www.w3.org/1999/xlink"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg">
+  <sodipodi:namedview
+     id="namedview1050"
+     pagecolor="#505050"
+     bordercolor="#ffffff"
+     borderopacity="1"
+     inkscape:pageshadow="0"
+     inkscape:pageopacity="0"
+     inkscape:pagecheckerboard="1"
+     showgrid="false"
+     inkscape:snap-bbox="true"
+     inkscape:bbox-paths="true"
+     inkscape:bbox-nodes="true"
+     inkscape:snap-bbox-edge-midpoints="true"
+     inkscape:snap-bbox-midpoints="true"
+     inkscape:snap-intersection-paths="true"
+     inkscape:object-paths="true"
+     inkscape:snap-smooth-nodes="true"
+     inkscape:snap-midpoints="true"
+     inkscape:snap-object-midpoints="true"
+     inkscape:snap-center="true"
+     inkscape:snap-text-baseline="true"
+     inkscape:snap-page="true"
+     fit-margin-top="0"
+     fit-margin-left="0"
+     fit-margin-right="0"
+     fit-margin-bottom="0"
+     inkscape:zoom="1.1996734"
+     inkscape:cx="186.71748"
+     inkscape:cy="100.02722"
+     inkscape:window-width="1920"
+     inkscape:window-height="1007"
+     inkscape:window-x="0"
+     inkscape:window-y="0"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="svg1048" />
+  <defs
+     id="defs974">
+    <linearGradient
+       id="a">
+      <stop
+         offset="0"
+         stop-color="#fff"
+         stop-opacity=".098"
+         id="stop968" />
+      <stop
+         offset="1"
+         stop-color="#fff"
+         stop-opacity="0"
+         id="stop970" />
+    </linearGradient>
+    <radialGradient
+       xlink:href="#a"
+       id="b"
+       cx="113"
+       cy="-12.89"
+       fx="113"
+       fy="-12.89"
+       r="59.661999"
+       gradientTransform="matrix(0,1.96105,-1.97781,0,254.507,78.763)"
+       gradientUnits="userSpaceOnUse" />
+  </defs>
+  <g
+     transform="translate(-332,-355.362)"
+     id="g1046">
+    <rect
+       style="stroke:none;marker:none"
+       width="560"
+       height="164"
+       x="332"
+       y="355.362"
+       rx="20"
+       ry="20"
+       color="#000000"
+       overflow="visible"
+       stroke="#a6a6a6"
+       stroke-width="4"
+       id="rect976" />
+    <text
+       y="402.367"
+       x="508.95099"
+       style="line-height:100%;-inkscape-font-specification:'DejaVu Sans';marker:none"
+       color="#000000"
+       font-weight="400"
+       font-size="12.395px"
+       font-family="'DejaVu Sans'"
+       letter-spacing="0"
+       word-spacing="0"
+       overflow="visible"
+       fill="#ffffff"
+       id="text980"><tspan
+         y="402.367"
+         x="508.95099"
+         style="-inkscape-font-specification:'DejaVu Sans'"
+         font-size="34.125px"
+         id="tspan978">GET IT ON</tspan></text>
+    <text
+       style="line-height:100%;-inkscape-font-specification:'Rokkitt Bold';text-align:start;marker:none"
+       x="508.21301"
+       y="489.36099"
+       color="#000000"
+       font-weight="700"
+       font-size="29.709px"
+       font-family="Rokkitt"
+       letter-spacing="0"
+       word-spacing="0"
+       overflow="visible"
+       fill="#ffffff"
+       id="text984"><tspan
+         x="508.21301"
+         y="489.36099"
+         style="line-height:100%;-inkscape-font-specification:'Roboto Slab Bold';text-align:start"
+         font-size="95px"
+         font-family="'Roboto Slab'"
+         id="tspan982">F-Droid</tspan></text>
+    <g
+       fill-rule="evenodd"
+       id="g994">
+      <path
+         d="m 2.589,1006.862 4.25,5.5"
+         fill="#8ab000"
+         stroke="#769616"
+         stroke-width="2.5"
+         stroke-linecap="round"
+         transform="matrix(-2.63159,0,0,2.63157,483.158,-2270.475)"
+         id="path986" />
+      <path
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         d="m 476.286,375.862 c 1.193,0.031 2.004,0.497 2.58,1.18 -5.333,6.34 -6.232,7.347 -13.514,16.372 -2.683,3.472 -5.478,1.678 -2.795,-1.793 l 11.185,-14.474 c 0.602,-0.804 1.54,-1.258 2.544,-1.285 z"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#ffffff"
+         fill-opacity="0.298"
+         id="path988" />
+      <path
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         d="m 478.89,377.075 c 0.325,0.39 1.476,2.118 0.058,4.096 l -11.184,14.473 c -2.683,3.471 -3.026,-1.611 -3.026,-1.611 0,0 9.828,-11.869 14.151,-16.958 z"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#263238"
+         fill-opacity="0.2"
+         id="path990" />
+      <path
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         d="m 477.006,376.48 c 1.153,0 2.525,0.373 2.169,2.102 -0.273,1.32 -12.266,15.985 -12.266,15.985 -2.683,3.47 -6.562,1.78 -3.879,-1.691 l 11.143,-14.402 c 0.685,-0.763 1.602,-1.957 2.833,-1.994 z"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#8ab000"
+         id="path992" />
+    </g>
+    <g
+       fill-rule="evenodd"
+       id="g1004">
+      <path
+         d="m 2.589,1006.862 4.25,5.5"
+         fill="#8ab000"
+         stroke="#769616"
+         stroke-width="2.5"
+         stroke-linecap="round"
+         transform="matrix(2.63159,0,0,2.63157,356.842,-2270.475)"
+         id="path996" />
+      <path
+         d="m 363.714,375.862 c -1.193,0.031 -2.004,0.497 -2.58,1.18 5.333,6.34 6.232,7.347 13.514,16.372 2.683,3.472 5.478,1.678 2.795,-1.793 l -11.185,-14.474 c -0.602,-0.804 -1.54,-1.258 -2.544,-1.285 z"
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#ffffff"
+         fill-opacity="0.298"
+         id="path998" />
+      <path
+         d="m 361.11,377.075 c -0.325,0.39 -1.476,2.118 -0.058,4.096 l 11.184,14.473 c 2.683,3.471 3.026,-1.611 3.026,-1.611 0,0 -9.828,-11.869 -14.151,-16.958 z"
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#263238"
+         fill-opacity="0.2"
+         id="path1000" />
+      <path
+         d="m 362.995,376.48 c -1.153,0 -2.526,0.373 -2.17,2.102 0.273,1.32 12.266,15.985 12.266,15.985 2.683,3.47 6.562,1.78 3.879,-1.691 l -11.143,-14.402 c -0.685,-0.763 -1.602,-1.957 -2.832,-1.994 z"
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#8ab000"
+         id="path1002" />
+    </g>
+    <g
+       transform="matrix(2.63159,0,0,2.63157,467.369,-2270.475)"
+       id="g1014">
+      <rect
+         ry="3"
+         rx="3"
+         y="1010.36"
+         x="-37"
+         height="12.92"
+         width="38"
+         fill="#aeea00"
+         id="rect1006" />
+      <rect
+         width="38"
+         height="10"
+         x="-37"
+         y="1013.279"
+         rx="3"
+         ry="3"
+         fill="#263238"
+         fill-opacity="0.2"
+         id="rect1008" />
+      <rect
+         width="38"
+         height="10"
+         x="-37"
+         y="1010.362"
+         rx="3"
+         ry="3"
+         fill="#ffffff"
+         fill-opacity="0.298"
+         id="rect1010" />
+      <rect
+         width="38"
+         height="10.641"
+         x="-37"
+         y="1011.5"
+         rx="3"
+         ry="2.4560001"
+         fill="#aeea00"
+         id="rect1012" />
+    </g>
+    <g
+       transform="matrix(2.63159,0,0,2.63157,356.842,-2270.745)"
+       id="g1024">
+      <rect
+         ry="3"
+         rx="3"
+         y="1024.522"
+         x="5"
+         height="25.84"
+         width="38"
+         fill="#1976d2"
+         id="rect1016" />
+      <rect
+         width="38"
+         height="13"
+         x="5"
+         y="1037.3621"
+         rx="3"
+         ry="3"
+         fill="#263238"
+         fill-opacity="0.2"
+         id="rect1018" />
+      <rect
+         width="38"
+         height="13"
+         x="5"
+         y="1024.442"
+         rx="3"
+         ry="3"
+         fill="#ffffff"
+         fill-opacity="0.2"
+         id="rect1020" />
+      <rect
+         width="38"
+         height="23.559999"
+         x="5"
+         y="1025.662"
+         rx="3"
+         ry="2.7179999"
+         fill="#1976d2"
+         id="rect1022" />
+    </g>
+    <g
+       transform="matrix(2.63159,0,0,2.63157,356.842,396.264)"
+       id="g1030">
+      <path
+         d="m 24,17.75 c -2.88,0 -5.32,1.985 -6.033,4.65 H 21.18 A 3.215,3.215 0 0 1 24,20.75 3.228,3.228 0 0 1 27.25,24 3.228,3.228 0 0 1 24,27.25 3.219,3.219 0 0 1 21.07,25.4 h -3.154 c 0.642,2.766 3.132,4.85 6.084,4.85 3.434,0 6.25,-2.816 6.25,-6.25 0,-3.434 -2.816,-6.25 -6.25,-6.25 z"
+         style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal"
+         color="#000000"
+         font-weight="400"
+         font-family="sans-serif"
+         white-space="normal"
+         overflow="visible"
+         fill="#0d47a1"
+         id="path1026" />
+      <circle
+         r="9.5500002"
+         cy="24"
+         cx="24"
+         fill="none"
+         stroke="#0d47a1"
+         stroke-width="1.9"
+         stroke-linecap="round"
+         id="circle1028" />
+    </g>
+    <g
+       transform="matrix(2.63159,0,0,2.63157,356.842,-2269.159)"
+       id="g1036">
+      <ellipse
+         ry="3.875"
+         rx="3.375"
+         cx="14.375"
+         cy="1016.487"
+         fill="#263238"
+         fill-opacity="0.2"
+         id="ellipse1032" />
+      <circle
+         r="3.375"
+         cy="1016.987"
+         cx="14.375"
+         fill="#ffffff"
+         id="circle1034" />
+    </g>
+    <g
+       transform="matrix(2.63159,0,0,2.63157,408.158,-2269.159)"
+       id="g1042">
+      <ellipse
+         cy="1016.487"
+         cx="14.375"
+         rx="3.375"
+         ry="3.875"
+         fill="#263238"
+         fill-opacity="0.2"
+         id="ellipse1038" />
+      <circle
+         cx="14.375"
+         cy="1016.987"
+         r="3.375"
+         fill="#ffffff"
+         id="circle1040" />
+    </g>
+    <path
+       d="m 282.715,299.835 a 3.29,3.29 0 0 0 -2.662,5.336 l 9.474,12.261 A 7.894,7.894 0 0 0 289,320.257 v 18.21 a 7.877,7.877 0 0 0 7.895,7.895 h 84.21 A 7.877,7.877 0 0 0 389,338.468 v -18.211 c 0,-0.999 -0.19,-1.949 -0.525,-2.826 l 9.472,-12.26 a 3.29,3.29 0 0 0 -2.433,-5.334 3.29,3.29 0 0 0 -2.772,1.31 l -9.013,11.666 a 7.91,7.91 0 0 0 -2.624,-0.45 h -84.21 c -0.922,0 -1.8,0.163 -2.622,0.45 l -9.015,-11.666 a 3.29,3.29 0 0 0 -2.543,-1.312 z m 14.18,49.527 A 7.877,7.877 0 0 0 289,357.257 v 52.21 a 7.877,7.877 0 0 0 7.895,7.895 h 84.21 A 7.877,7.877 0 0 0 389,409.468 v -52.211 a 7.877,7.877 0 0 0 -7.895,-7.895 z"
+       style="line-height:normal;text-indent:0;text-align:start;text-decoration-line:none;text-decoration-style:solid;text-decoration-color:#000000;text-transform:none;isolation:auto;mix-blend-mode:normal;fill:url(#b)"
+       color="#000000"
+       font-weight="400"
+       font-family="sans-serif"
+       white-space="normal"
+       overflow="visible"
+       fill="url(#b)"
+       fill-rule="evenodd"
+       transform="translate(81,76)"
+       id="path1044" />
+  </g>
+</svg>

apps/smp-server/static/media/google_play.svg

@@ -0,0 +1,39 @@
+<svg width="135" height="41" viewBox="0 0 135 41" fill="none" xmlns="http://www.w3.org/2000/svg">
+<path d="M130 40.5H5C2.2 40.5 0 38.3 0 35.5V5.5C0 2.7 2.2 0.5 5 0.5H130C132.8 0.5 135 2.7 135 5.5V35.5C135 38.3 132.8 40.5 130 40.5Z" fill="black"/>
+<path d="M47.4 10.7C47.4 11.5 47.2 12.2 46.7 12.7C46.1 13.3 45.4 13.6 44.5 13.6C43.6 13.6 42.9 13.3 42.3 12.7C41.7 12.1 41.4 11.4 41.4 10.5C41.4 9.60002 41.7 8.90002 42.3 8.30002C42.9 7.70002 43.6 7.40002 44.5 7.40002C44.9 7.40002 45.3 7.50002 45.7 7.70002C46.1 7.90002 46.4 8.10002 46.6 8.40002L46.1 8.90002C45.7 8.40002 45.2 8.20002 44.5 8.20002C43.9 8.20002 43.3 8.40002 42.9 8.90002C42.4 9.30002 42.2 9.90002 42.2 10.6C42.2 11.3 42.4 11.9 42.9 12.3C43.4 12.7 43.9 13 44.5 13C45.2 13 45.7 12.8 46.2 12.3C46.5 12 46.7 11.6 46.7 11.1H44.5V10.3H47.4V10.7V10.7ZM52 8.20002H49.3V10.1H51.8V10.8H49.3V12.7H52V13.5H48.5V7.50002H52V8.20002ZM55.3 13.5H54.5V8.20002H52.8V7.50002H57V8.20002H55.3V13.5ZM59.9 13.5V7.50002H60.7V13.5H59.9ZM64.1 13.5H63.3V8.20002H61.6V7.50002H65.7V8.20002H64V13.5H64.1ZM73.6 12.7C73 13.3 72.3 13.6 71.4 13.6C70.5 13.6 69.8 13.3 69.2 12.7C68.6 12.1 68.3 11.4 68.3 10.5C68.3 9.60002 68.6 8.90002 69.2 8.30002C69.8 7.70002 70.5 7.40002 71.4 7.40002C72.3 7.40002 73 7.70002 73.6 8.30002C74.2 8.90002 74.5 9.60002 74.5 10.5C74.5 11.4 74.2 12.1 73.6 12.7ZM69.8 12.2C70.2 12.6 70.8 12.9 71.4 12.9C72 12.9 72.6 12.7 73 12.2C73.4 11.8 73.7 11.2 73.7 10.5C73.7 9.80002 73.5 9.20002 73 8.80002C72.6 8.40002 72 8.10002 71.4 8.10002C70.8 8.10002 70.2 8.30002 69.8 8.80002C69.4 9.20002 69.1 9.80002 69.1 10.5C69.1 11.2 69.3 11.8 69.8 12.2ZM75.6 13.5V7.50002H76.5L79.4 12.2V7.50002H80.2V13.5H79.4L76.3 8.60002V13.5H75.6V13.5Z" fill="white" stroke="white" stroke-width="0.2" stroke-miterlimit="10"/>
+<path d="M68.1 22.3C65.7 22.3 63.8 24.1 63.8 26.6C63.8 29 65.7 30.9 68.1 30.9C70.5 30.9 72.4 29.1 72.4 26.6C72.4 24 70.5 22.3 68.1 22.3ZM68.1 29.1C66.8 29.1 65.7 28 65.7 26.5C65.7 25 66.8 23.9 68.1 23.9C69.4 23.9 70.5 24.9 70.5 26.5C70.5 28 69.4 29.1 68.1 29.1ZM58.8 22.3C56.4 22.3 54.5 24.1 54.5 26.6C54.5 29 56.4 30.9 58.8 30.9C61.2 30.9 63.1 29.1 63.1 26.6C63.1 24 61.2 22.3 58.8 22.3ZM58.8 29.1C57.5 29.1 56.4 28 56.4 26.5C56.4 25 57.5 23.9 58.8 23.9C60.1 23.9 61.2 24.9 61.2 26.5C61.2 28 60.1 29.1 58.8 29.1ZM47.7 23.6V25.4H52C51.9 26.4 51.5 27.2 51 27.7C50.4 28.3 49.4 29 47.7 29C45 29 43 26.9 43 24.2C43 21.5 45.1 19.4 47.7 19.4C49.1 19.4 50.2 20 51 20.7L52.3 19.4C51.2 18.4 49.8 17.6 47.8 17.6C44.2 17.6 41.1 20.6 41.1 24.2C41.1 27.8 44.2 30.8 47.8 30.8C49.8 30.8 51.2 30.2 52.4 28.9C53.6 27.7 54 26 54 24.7C54 24.3 54 23.9 53.9 23.6H47.7V23.6ZM93.1 25C92.7 24 91.7 22.3 89.5 22.3C87.3 22.3 85.5 24 85.5 26.6C85.5 29 87.3 30.9 89.7 30.9C91.6 30.9 92.8 29.7 93.2 29L91.8 28C91.3 28.7 90.7 29.2 89.7 29.2C88.7 29.2 88.1 28.8 87.6 27.9L93.3 25.5L93.1 25V25ZM87.3 26.4C87.3 24.8 88.6 23.9 89.5 23.9C90.2 23.9 90.9 24.3 91.1 24.8L87.3 26.4ZM82.6 30.5H84.5V18H82.6V30.5ZM79.6 23.2C79.1 22.7 78.3 22.2 77.3 22.2C75.2 22.2 73.2 24.1 73.2 26.5C73.2 28.9 75.1 30.7 77.3 30.7C78.3 30.7 79.1 30.2 79.5 29.7H79.6V30.3C79.6 31.9 78.7 32.8 77.3 32.8C76.2 32.8 75.4 32 75.2 31.3L73.6 32C74.1 33.1 75.3 34.5 77.4 34.5C79.6 34.5 81.4 33.2 81.4 30.1V22.5H79.6V23.2V23.2ZM77.4 29.1C76.1 29.1 75 28 75 26.5C75 25 76.1 23.9 77.4 23.9C78.7 23.9 79.7 25 79.7 26.5C79.7 28 78.7 29.1 77.4 29.1ZM101.8 18H97.3V30.5H99.2V25.8H101.8C103.9 25.8 105.9 24.3 105.9 21.9C105.9 19.5 103.9 18 101.8 18V18ZM101.9 24H99.2V19.7H101.9C103.3 19.7 104.1 20.9 104.1 21.8C104 22.9 103.2 24 101.9 24ZM113.4 22.2C112 22.2 110.6 22.8 110.1 24.1L111.8 24.8C112.2 24.1 112.8 23.9 113.5 23.9C114.5 23.9 115.4 24.5 115.5 25.5V25.6C115.2 25.4 114.4 25.1 113.6 25.1C111.8 25.1 110 26.1 110 27.9C110 29.6 111.5 30.7 113.1 30.7C114.4 30.7 115 30.1 115.5 29.5H115.6V30.5H117.4V25.7C117.2 23.5 115.5 22.2 113.4 22.2V22.2ZM113.2 29.1C112.6 29.1 111.7 28.8 111.7 28C111.7 27 112.8 26.7 113.7 26.7C114.5 26.7 114.9 26.9 115.4 27.1C115.2 28.3 114.2 29.1 113.2 29.1V29.1ZM123.7 22.5L121.6 27.9H121.5L119.3 22.5H117.3L120.6 30.1L118.7 34.3H120.6L125.7 22.5H123.7V22.5ZM106.9 30.5H108.8V18H106.9V30.5Z" fill="white"/>
+<path d="M10.4 8C10.1 8.3 10 8.8 10 9.4V31.5C10 32.1 10.2 32.6 10.5 32.9L10.6 33L23 20.6V20.4L10.4 8Z" fill="url(#paint0_linear_7_408)"/>
+<path d="M27 24.8L22.9 20.7V20.4L27 16.3L27.1 16.4L32 19.2C33.4 20 33.4 21.3 32 22.1L27 24.8V24.8Z" fill="url(#paint1_linear_7_408)"/>
+<path d="M27.1 24.7L22.9 20.5L10.4 33C10.9 33.5 11.6 33.5 12.5 33.1L27.1 24.7" fill="url(#paint2_linear_7_408)"/>
+<path d="M27.1 16.3001L12.5 8.00005C11.6 7.50005 10.9 7.60005 10.4 8.10005L22.9 20.5001L27.1 16.3001V16.3001Z" fill="url(#paint3_linear_7_408)"/>
+<path opacity="0.2" d="M27 24.6L12.5 32.8C11.7 33.3 11 33.2 10.5 32.8L10.4 32.9L10.5 33C11 33.4 11.7 33.5 12.5 33L27 24.6Z" fill="black"/>
+<path opacity="0.12" d="M10.4 32.8C10.1 32.5 10 32 10 31.4V31.5C10 32.1 10.2 32.6 10.5 32.9V32.8H10.4ZM32 21.8L27 24.6L27.1 24.7L32 21.9C32.7 21.5 33 21 33 20.5C33 21 32.6 21.4 32 21.8V21.8Z" fill="black"/>
+<path opacity="0.25" d="M12.5 8.10003L32 19.2C32.6 19.6 33 20 33 20.5C33 20 32.7 19.5 32 19.1L12.5 8.00003C11.1 7.20003 10 7.80003 10 9.40003V9.50003C10 8.00003 11.1 7.30003 12.5 8.10003Z" fill="white"/>
+<defs>
+<linearGradient id="paint0_linear_7_408" x1="21.8" y1="9.21" x2="5.017" y2="25.992" gradientUnits="userSpaceOnUse">
+<stop stop-color="#00A0FF"/>
+<stop offset="0.007" stop-color="#00A1FF"/>
+<stop offset="0.26" stop-color="#00BEFF"/>
+<stop offset="0.512" stop-color="#00D2FF"/>
+<stop offset="0.76" stop-color="#00DFFF"/>
+<stop offset="1" stop-color="#00E3FF"/>
+</linearGradient>
+<linearGradient id="paint1_linear_7_408" x1="33.834" y1="20.501" x2="9.63699" y2="20.501" gradientUnits="userSpaceOnUse">
+<stop stop-color="#FFE000"/>
+<stop offset="0.409" stop-color="#FFBD00"/>
+<stop offset="0.775" stop-color="#FFA500"/>
+<stop offset="1" stop-color="#FF9C00"/>
+</linearGradient>
+<linearGradient id="paint2_linear_7_408" x1="24.827" y1="22.796" x2="2.069" y2="45.554" gradientUnits="userSpaceOnUse">
+<stop stop-color="#FF3A44"/>
+<stop offset="1" stop-color="#C31162"/>
+</linearGradient>
+<linearGradient id="paint3_linear_7_408" x1="7.29699" y1="0.676051" x2="17.46" y2="10.8391" gradientUnits="userSpaceOnUse">
+<stop stop-color="#32A071"/>
+<stop offset="0.069" stop-color="#2DA771"/>
+<stop offset="0.476" stop-color="#15CF74"/>
+<stop offset="0.801" stop-color="#06E775"/>
+<stop offset="1" stop-color="#00F076"/>
+</linearGradient>
+</defs>
+</svg>

apps/smp-server/static/media/logo-symbol-dark.svg

@@ -0,0 +1,10 @@
+<svg width="34" height="35" viewBox="0 0 34 35" fill="none" xmlns="http://www.w3.org/2000/svg">
+<path fill-rule="evenodd" clip-rule="evenodd" d="M3.02958 8.60922L8.622 14.2013L14.3705 8.45375L17.1669 11.2498L11.4183 16.9972L17.0114 22.5895L14.1373 25.4633L8.54422 19.871L2.79636 25.6187L0 22.8227L5.74794 17.075L0.155484 11.483L3.02958 8.60922Z" fill="white"/>
+<path fill-rule="evenodd" clip-rule="evenodd" d="M14.0923 25.5156L16.944 22.6642L16.9429 22.6634L22.6467 16.9612L17.0513 11.3675L17.0523 11.367L14.2548 8.56979L8.65972 2.97535L11.5114 0.123963L17.1061 5.71849L22.8099 0.015625L25.6074 2.81285L19.9035 8.51562L25.4984 14.1099L31.2025 8.40729L34 11.2045L28.2958 16.907L33.8917 22.5017L31.0399 25.3531L25.4442 19.7584L19.7409 25.4611L25.3365 31.0559L22.4848 33.9073L16.8892 28.3124L11.1864 34.0156L8.38885 31.2184L14.0923 25.5156Z" fill="url(#paint0_linear_656_10815)"/>
+<defs>
+<linearGradient id="paint0_linear_656_10815" x1="12.8381" y1="-0.678252" x2="9.54355" y2="31.4493" gradientUnits="userSpaceOnUse">
+<stop stop-color="#01F1FF"/>
+<stop offset="1" stop-color="#0197FF"/>
+</linearGradient>
+</defs>
+</svg>

apps/smp-server/static/media/logo-symbol-light.svg

@@ -0,0 +1,15 @@
+<svg width="34" height="34" viewBox="0 0 34 34" fill="none" xmlns="http://www.w3.org/2000/svg">
+<g clip-path="url(#clip0_14_10)">
+<path fill-rule="evenodd" clip-rule="evenodd" d="M3.02972 8.59396L8.62219 14.186L14.3703 8.43848L17.1668 11.2346L11.4182 16.982L17.0112 22.5742L14.1371 25.448L8.5441 19.8557L2.79651 25.6035L0 22.8074L5.74813 17.0597L0.155656 11.4678L3.02972 8.59396Z" fill="#023789"/>
+<path fill-rule="evenodd" clip-rule="evenodd" d="M14.0922 25.5L16.9434 22.6486L16.9423 22.6478L22.6464 16.9456L17.0512 11.3519L17.0518 11.3514L14.2542 8.55418L8.65961 2.95973L11.5114 0.108337L17.106 5.70288L22.8095 0L25.607 2.79722L19.903 8.5L25.4981 14.0943L31.2022 8.39169L33.9997 11.1889L28.2957 16.8914L33.8914 22.4861L31.0396 25.3375L25.4439 19.7428L19.7404 25.4454L25.3361 31.0403L22.4843 33.8917L16.8887 28.2968L11.1862 34L8.38867 31.2028L14.0922 25.5Z" fill="url(#paint0_linear_14_10)"/>
+</g>
+<defs>
+<linearGradient id="paint0_linear_14_10" x1="12.8379" y1="-0.693875" x2="9.54344" y2="31.4337" gradientUnits="userSpaceOnUse">
+<stop stop-color="#01F1FF"/>
+<stop offset="1" stop-color="#0197FF"/>
+</linearGradient>
+<clipPath id="clip0_14_10">
+<rect width="34" height="34" fill="white"/>
+</clipPath>
+</defs>
+</svg>

apps/smp-server/static/media/moon.svg

@@ -0,0 +1,3 @@
+<svg width="16" height="16" viewBox="0 0 16 16" fill="none" xmlns="http://www.w3.org/2000/svg">
+<path d="M2.92814 12.6789C6.17655 15.9347 11.7044 15.6463 14.5425 12.0117C14.6636 11.8566 14.6825 11.6448 14.5907 11.4708C14.4989 11.2967 14.3136 11.1926 14.1172 11.2049C11.5269 11.3673 8.97627 10.4315 7.0743 8.52765C5.17264 6.62414 4.23958 4.06868 4.40169 1.47281C4.41397 1.2762 4.30965 1.09069 4.13526 0.999048C3.96088 0.907402 3.74893 0.926696 3.59396 1.04833C3.36099 1.23117 3.13828 1.42685 2.92823 1.63726C-0.111372 4.68223 -0.111585 9.63533 2.92814 12.6789Z" stroke="black" stroke-miterlimit="10" stroke-linejoin="round"/>
+</svg>

apps/smp-server/static/media/script.js

@@ -0,0 +1,39 @@
+const isMobile = {
+    Android: () => navigator.userAgent.match(/Android/i),
+    iOS: () => navigator.userAgent.match(/iPhone|iPad|iPod/i)
+};
+
+window.addEventListener('click', clickHandler)
+
+if (isMobile.iOS) {
+    for (const btn of document.getElementsByClassName("close-overlay-btn")) {
+        btn.addEventListener("touchend", (e) => setTimeout(() => closeOverlay(e), 100))
+    }
+}
+
+function clickHandler(e) {
+    if (e.target.closest('.contact-tab-btn')) {
+        e.target.closest('.contact-tab').classList.toggle('active')
+    }
+}
+
+window.addEventListener('load', () => {
+    const googlePlayBtn = document.querySelector('.google-play-btn');
+    const appleStoreBtn = document.querySelector('.apple-store-btn');
+    const fDroidBtn = document.querySelector('.f-droid-btn');
+    if (!googlePlayBtn || !appleStoreBtn || !fDroidBtn) return;
+
+
+    if (isMobile.Android()) {
+        googlePlayBtn.classList.remove('hidden');
+        fDroidBtn.classList.remove('hidden');
+    }
+    else if (isMobile.iOS()) {
+        appleStoreBtn.classList.remove('hidden');
+    }
+    else {
+        appleStoreBtn.classList.remove('hidden');
+        googlePlayBtn.classList.remove('hidden');
+        fDroidBtn.classList.remove('hidden');
+    }
+})

apps/smp-server/static/media/style.css

@@ -0,0 +1,410 @@
+@font-face {
+  font-family: Gilroy;
+  src: url("GilroyRegular.woff2") format("woff2");
+  font-weight: 400;
+  font-style: normal;
+}
+
+@font-face {
+  font-family: Gilroy;
+  src: url("GilroyLight.woff2") format("woff2");
+  font-weight: 300;
+  font-style: normal;
+}
+
+@font-face {
+  font-family: Gilroy;
+  src: url("GilroyMedium.woff2") format("woff2");
+  font-weight: 500;
+  font-style: normal;
+}
+
+@font-face {
+  font-family: Gilroy;
+  src: url("GilroyBold.woff2") format("woff2");
+  font-weight: 700;
+  font-style: normal;
+}
+
+@font-face {
+  font-family: Gilroy;
+  src: url("GilroyRegularItalic.woff2") format("woff2");
+  font-weight: 400;
+  font-style: italic;
+}
+
+html {
+  scroll-behavior: smooth;
+  font-family: Gilroy, Helvetica, sans-serif;
+  ;
+  letter-spacing: 0.003em;
+}
+
+img {
+  user-select: none;
+  -webkit-user-select: none;
+  /* For Safari and older Chrome versions */
+  -moz-user-select: none;
+  /* For Firefox */
+  -ms-user-select: none;
+  /* For Internet Explorer and Edge */
+}
+
+/* NEW SITE */
+.container,
+.container-fluid,
+.container-xxl,
+.container-xl,
+.container-lg,
+.container-md,
+.container-sm {
+  width: 100%;
+  /* padding: 0 20px; */
+  margin-right: auto;
+  margin-left: auto;
+}
+
+@media (min-width: 576px) {
+
+  .container-sm,
+  .container {
+    max-width: 540px;
+  }
+}
+
+@media (min-width: 768px) {
+
+  .container-md,
+  .container-sm,
+  .container {
+    max-width: 720px;
+  }
+}
+
+@media (min-width: 992px) {
+
+  .container-lg,
+  .container-md,
+  .container-sm,
+  .container {
+    max-width: 960px;
+  }
+}
+
+@media (min-width: 1200px) {
+
+  .container-xl,
+  .container-lg,
+  .container-md,
+  .container-sm,
+  .container {
+    max-width: 1140px;
+  }
+}
+
+@media (min-width: 1400px) {
+
+  .container-xxl,
+  .container-xl,
+  .container-lg,
+  .container-md,
+  .container-sm,
+  .container {
+    max-width: 1320px;
+  }
+}
+
+.gradient-text {
+  background: -webkit-linear-gradient(to bottom, #53C1FF -50%, #0053D0 160%);
+  background: linear-gradient(to bottom, #53C1FF -50%, #0053D0 160%);
+  -webkit-background-clip: text;
+  -webkit-text-fill-color: transparent;
+  background-clip: text;
+  text-fill-color: transparent;
+}
+
+.dark .border-gradient {
+  background:
+    linear-gradient(#11182F, #11182F) padding-box,
+    linear-gradient(to bottom, transparent, #01F1FF 58%) border-box;
+  border: 1px solid transparent;
+}
+
+.dark .only-light {
+  display: none;
+}
+
+.only-dark {
+  display: none;
+}
+
+.dark .only-dark {
+  display: inherit;
+}
+
+.menu-link {
+  font-size: 16px;
+  line-height: 33.42px;
+  color: #0D0E12;
+}
+
+.dark .menu-link {
+  color: #fff;
+}
+
+.nav-link ul li a.active {
+  color: #0053D0;
+
+}
+
+.dark .nav-link ul li a.active {
+  color: #66D9E2;
+}
+
+@media (min-width:1024px) {
+
+  .nav-link-text,
+  .menu-link {
+    display: inline-block;
+    position: relative;
+    color: #0D0E12;
+  }
+
+  .nav-link-text::before,
+  .active .nav-link-text::before,
+  .menu-link::before {
+    content: "";
+    position: absolute;
+    width: 0;
+    height: 1px;
+    bottom: 0;
+    right: 0;
+    /* background-color: initial; */
+    transition: width 0.25s ease-out;
+  }
+
+  .menu-link::before {
+    background-color: #0D0E12;
+  }
+
+  .dark .menu-link::before {
+    background-color: #fff;
+  }
+
+  .active .nav-link-text::before {
+    width: 100%;
+  }
+
+  .nav-link:hover .nav-link-text::before,
+  .menu-link:hover::before {
+    width: 100%;
+    left: 0;
+    right: auto;
+  }
+}
+
+
+.sub-menu {
+  visibility: hidden;
+  opacity: 0;
+  color: #505158;
+}
+
+.sub-menu .no-hover {
+  color: #505158 !important;
+}
+
+.dark .sub-menu,
+.dark .sub-menu .no-hover {
+  color: #fff !important;
+}
+
+.dark .sub-menu li:hover {
+  color: #66D9E2;
+}
+
+.sub-menu li:hover {
+  color: #0053D0;
+}
+
+.sub-menu {
+  transition: all .3s ease !important;
+}
+
+.nav-link span svg,
+header nav {
+  transition: all 0.5s ease;
+}
+
+.nav-link:hover span svg {
+  transform: rotate(180deg);
+}
+
+@media (min-width:1024px) {
+
+  .nav-link:hover .sub-menu,
+  .nav-link:focus-within .sub-menu {
+    visibility: visible;
+    opacity: 1;
+    margin-top: 0;
+  }
+}
+
+@media (max-width: 1024px) {
+  .sub-menu {
+    max-height: 0;
+    transform: translateY(-10px);
+    transition: all .7s ease !important;
+  }
+
+  .active .sub-menu {
+    max-height: 600px;
+    transform: translateY(0px);
+    opacity: 1;
+    visibility: visible;
+    margin-top: 0;
+  }
+
+  header nav {
+    visibility: hidden;
+    opacity: 0;
+    transform: translateX(100%);
+  }
+
+  header nav.open {
+    visibility: visible;
+    opacity: 1;
+    transform: translateX(0);
+  }
+}
+
+.lock-scroll {
+  overflow: hidden;
+}
+
+/* hero */
+header {
+  transition: all .7s ease;
+}
+
+.primary-header {
+  background: linear-gradient(270deg, #0053D0 35.85%, #0197FF 94.78%);
+  -webkit-background-clip: text;
+  -webkit-text-fill-color: transparent;
+  background-clip: text;
+  text-shadow: 0px 4px 74px #e9e7e2;
+}
+
+.dark .primary-header {
+  background: linear-gradient(270deg, #70F0F9 100%, #70F0F9 100%);
+  -webkit-background-clip: text;
+  -webkit-text-fill-color: transparent;
+  background-clip: text;
+  text-shadow: none;
+}
+
+.secondary-header {
+  color: #606c71;
+  text-shadow: 0px 4px 74px #e9e7e2;
+}
+
+.dark .secondary-header {
+  color: #fff;
+  text-shadow: none;
+}
+
+.description {
+  width: 31rem;
+}
+
+p a {
+  color: #0053D0;
+  text-decoration: underline;
+  text-underline-offset: 2px;
+}
+
+.dark p a {
+  color: #70F0F9;
+}
+
+/* For Contact & Invitation Page */
+.primary-header-contact {
+  background: linear-gradient(251.16deg, #53c1ff 1.1%, #0053d0 100.82%);
+  -webkit-background-clip: text;
+  -webkit-text-fill-color: transparent;
+  background-clip: text;
+  text-shadow: 0px 4px 74px #e9e7e2;
+}
+
+.dark .primary-header-contact {
+  background: linear-gradient(270deg, #70F0F9 100%, #70F0F9 100%);
+  -webkit-background-clip: text;
+  -webkit-text-fill-color: transparent;
+  background-clip: text;
+  text-shadow: none;
+}
+
+.secondary-header-contact {
+  text-shadow: 0px 4px 74px #e9e7e2;
+}
+
+.dark .secondary-header-contact {
+  text-shadow: none;
+}
+
+.content_copy_with_tooltip {
+  background-color: #f8f8f6;
+  border-radius: 50px;
+  padding-bottom: 4px;
+  padding-top: 8px;
+  margin-top: 16px;
+  margin-bottom: 16px;
+}
+
+.content_copy_with_tooltip .tooltip {
+  vertical-align: -6px;
+}
+
+.content_copy_with_tooltip .content {
+  font-size: 15px;
+}
+
+.contact-tab>.contact-tab-content,
+.job-tab>.job-tab-content {
+  opacity: 0;
+  max-height: 0;
+  transition: all 0.5s ease;
+  visibility: hidden;
+  transform: translateY(10px);
+  overflow: hidden;
+}
+
+.contact-tab svg,
+.job-tab svg {
+  transform: rotate(-180deg);
+  transition: all .5s ease;
+}
+
+.contact-tab.active>.contact-tab-content,
+.job-tab.active>.job-tab-content {
+  opacity: 1;
+  max-height: 300px;
+  visibility: visible;
+  transform: translateY(0px);
+}
+
+.for-tablet .contact-tab.active>.contact-tab-content,
+.for-tablet .job-tab.active>.job-tab-content {
+  min-height: 450px;
+}
+
+.contact-tab.active svg,
+.contact-tab:hover svg,
+.job-tab.active svg,
+.job-tab:hover svg {
+  transform: rotate(0deg);
+}
+
+.d-none-if-js-disabled {
+  display: none !important;
+}

apps/smp-server/static/media/sun.svg

@@ -0,0 +1,11 @@
+<svg width="24" height="24" viewBox="0 0 24 24" fill="none" xmlns="http://www.w3.org/2000/svg">
+<path d="M23.9958 12.2815C23.9363 12.3954 23.8849 12.5146 23.8158 12.6224C23.5945 12.9674 23.2766 13.1624 22.8654 13.1685C22.2182 13.1782 21.5707 13.1764 20.9234 13.17C20.2781 13.1636 19.7772 12.6464 19.7773 11.9999C19.7774 11.3535 20.2754 10.8389 20.9237 10.8303C21.532 10.8221 22.1405 10.8258 22.7488 10.8278C23.3522 10.8298 23.7281 11.0908 23.9462 11.6508C23.956 11.6761 23.9789 11.6964 23.9958 11.719C23.9958 11.9064 23.9958 12.094 23.9958 12.2815Z" fill="white"/>
+<path d="M11.7154 24.0003C11.6217 23.9526 11.5256 23.9088 11.4345 23.8564C11.0545 23.6377 10.836 23.3104 10.8286 22.87C10.8175 22.2149 10.8179 21.5593 10.828 20.9042C10.8378 20.2738 11.3597 19.7812 11.9967 19.7812C12.6336 19.7812 13.155 20.2739 13.1654 20.9042C13.1757 21.5359 13.1717 22.168 13.1682 22.7998C13.1652 23.3392 12.8885 23.7369 12.3906 23.937C12.3509 23.9529 12.3153 23.979 12.2779 24.0003C12.0904 24.0003 11.9029 24.0003 11.7154 24.0003Z" fill="white"/>
+<path d="M17.2592 11.9958C17.2733 14.8825 14.9232 17.2468 12.0032 17.2612C9.11732 17.2754 6.75397 14.9264 6.73836 12.0041C6.72295 9.12027 9.07502 6.75326 11.9946 6.73835C14.8788 6.72363 17.2449 9.07587 17.2592 11.9958Z" stroke="white" stroke-width="1.5"/>
+<path d="M13.1693 2.11324C13.1692 2.43329 13.1744 2.75345 13.1682 3.07341C13.1555 3.7216 12.6425 4.21934 11.995 4.21864C11.3493 4.21789 10.8358 3.71808 10.828 3.06768C10.8204 2.42766 10.8201 1.78736 10.8283 1.14738C10.8365 0.500704 11.3562 -0.000843934 12.0007 1.06615e-06C12.6437 0.000846066 13.1564 0.504314 13.1684 1.15307C13.1743 1.47303 13.1694 1.79318 13.1693 2.11324Z" fill="white"/>
+<path d="M2.10878 13.1714C1.78877 13.1714 1.46872 13.1754 1.14885 13.1705C0.504832 13.1605 -0.000422735 12.6426 2.65407e-07 11.9987C0.000423265 11.3553 0.503376 10.838 1.15138 10.8301C1.79126 10.8223 2.43138 10.8222 3.07126 10.8303C3.72034 10.8385 4.21822 11.3541 4.21794 12.0012C4.21766 12.6477 3.71555 13.1609 3.06872 13.1706C2.7488 13.1753 2.42875 13.1714 2.10878 13.1714Z" fill="white"/>
+<path d="M6.85268 5.524C6.82732 6.152 6.60944 6.52005 6.16969 6.72981C5.73844 6.93552 5.29738 6.90378 4.94534 6.58208C4.41604 6.09838 3.90431 5.59148 3.42451 5.05894C3.02923 4.62023 3.09727 3.9209 3.51626 3.50792C3.9361 3.09409 4.63284 3.03567 5.06893 3.43194C5.59381 3.90888 6.09569 4.41446 6.57188 4.93996C6.73726 5.12252 6.79642 5.4014 6.85268 5.524Z" fill="white"/>
+<path d="M17.1426 18.4446C17.1749 17.8424 17.389 17.4819 17.8198 17.2738C18.2418 17.07 18.6812 17.0888 19.0265 17.3998C19.5706 17.8899 20.0919 18.4099 20.5814 18.9544C20.9675 19.384 20.895 20.0764 20.485 20.4873C20.0824 20.8907 19.3961 20.9756 18.9718 20.5988C18.4129 20.1026 17.89 19.5625 17.3864 19.0096C17.2323 18.8405 17.1926 18.5671 17.1426 18.4446Z" fill="white"/>
+<path d="M18.2026 6.84235C17.8449 6.82333 17.4821 6.61377 17.2723 6.18256C17.0626 5.7515 17.0878 5.30837 17.4061 4.95629C17.8919 4.41887 18.4055 3.90234 18.945 3.41897C19.3826 3.02693 20.0905 3.1037 20.4947 3.52429C20.9057 3.95198 20.9561 4.64003 20.5568 5.07805C20.0843 5.59645 19.576 6.08306 19.071 6.5708C18.8688 6.76619 18.6057 6.84832 18.2026 6.84235Z" fill="white"/>
+<path d="M5.54205 17.1445C6.14812 17.1747 6.51058 17.385 6.72137 17.8153C6.9323 18.2459 6.90765 18.6892 6.58942 19.0415C6.1037 19.5791 5.58933 20.0948 5.05088 20.5795C4.62165 20.9659 3.93035 20.8989 3.51681 20.4933C3.09875 20.0833 3.02864 19.3789 3.4227 18.942C3.908 18.404 4.42706 17.8934 4.96382 17.4066C5.13982 17.247 5.41663 17.1985 5.54205 17.1445Z" fill="white"/>
+</svg>

apps/smp-server/web/Static.hs

@@ -0,0 +1,176 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Static where
+
+import Control.Logger.Simple
+import Control.Monad
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.Maybe (fromMaybe)
+import Data.String (fromString)
+import Data.Text.Encoding (encodeUtf8)
+import Network.Wai.Application.Static as S
+import Network.Wai.Handler.Warp as W
+import qualified Network.Wai.Handler.WarpTLS as W
+import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Server.Information
+import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Util (tshow)
+import Static.Embedded as E
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath
+import UnliftIO.Concurrent (forkFinally)
+
+serveStaticFiles :: EmbeddedWebParams -> IO ()
+serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams} = do
+  forM_ webHttpPort $ \port -> flip forkFinally (\e -> logError $ "HTTP server crashed: " <> tshow e) $ do
+    logInfo $ "Serving static site on port " <> tshow port
+    W.runSettings (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
+  forM_ webHttpsParams $ \WebHttpsParams {port, cert, key} -> flip forkFinally (\e -> logError $ "HTTPS server crashed: " <> tshow e) $ do
+    logInfo $ "Serving static site on port " <> tshow port <> " (TLS)"
+    W.runTLS (W.tlsSettings cert key) (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
+  where
+    mkSettings port = setPort port defaultSettings
+
+generateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
+generateSite si onionHost sitePath = do
+  createDirectoryIfMissing True sitePath
+  B.writeFile (sitePath </> "index.html") $ serverInformation si onionHost
+  createDirectoryIfMissing True $ sitePath </> "media"
+  forM_ E.mediaContent $ \(path, bs) -> B.writeFile (sitePath </> "media" </> path) bs
+  createDirectoryIfMissing True $ sitePath </> "contact"
+  B.writeFile (sitePath </> "contact" </> "index.html") E.linkHtml
+  createDirectoryIfMissing True $ sitePath </> "invitation"
+  B.writeFile (sitePath </> "invitation" </> "index.html") E.linkHtml
+  logInfo $ "Generated static site contents at " <> tshow sitePath
+
+serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
+serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs
+  where
+    substs = substConfig <> maybe [] substInfo information <> [("onionHost", strEncode <$> onionHost)]
+    substConfig =
+      [ ( "persistence",
+          Just $ case persistence config of
+            SPMMemoryOnly -> "In-memory only"
+            SPMQueues -> "Queues"
+            SPMMessages -> "Queues and messages"
+        ),
+        ("messageExpiration", Just $ maybe "Never" (fromString . timedTTLText) $ messageExpiration config),
+        ("statsEnabled", Just . yesNo $ statsEnabled config),
+        ("newQueuesAllowed", Just . yesNo $ newQueuesAllowed config),
+        ("basicAuthEnabled", Just . yesNo $ basicAuthEnabled config)
+      ]
+    yesNo True = "Yes"
+    yesNo False = "No"
+    substInfo spi =
+      concat
+        [ basic,
+          maybe [("usageConditions", Nothing), ("usageAmendments", Nothing)] conds (usageConditions spi),
+          maybe [("operator", Nothing)] operatorE (operator spi),
+          maybe [("admin", Nothing)] admin (adminContacts spi),
+          maybe [("complaints", Nothing)] complaints (complaintsContacts spi),
+          maybe [("hosting", Nothing)] hostingE (hosting spi),
+          server
+        ]
+      where
+        basic =
+          [ ("sourceCode", Just . encodeUtf8 $ sourceCode spi),
+            ("website", encodeUtf8 <$> website spi)
+          ]
+        conds ServerConditions {conditions, amendments} =
+          [ ("usageConditions", Just $ encodeUtf8 conditions),
+            ("usageAmendments", encodeUtf8 <$> amendments)
+          ]
+        operatorE Entity {name, country} =
+          [ ("operator", Just ""),
+            ("operatorEntity", Just $ encodeUtf8 name),
+            ("operatorCountry", encodeUtf8 <$> country)
+          ]
+        admin ServerContactAddress {simplex, email, pgp} =
+          [ ("admin", Just ""),
+            ("adminSimplex", strEncode <$> simplex),
+            ("adminEmail", encodeUtf8 <$> email),
+            ("adminPGP", encodeUtf8 . pkURI <$> pgp),
+            ("adminPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
+          ]
+        complaints ServerContactAddress {simplex, email, pgp} =
+          [ ("complaints", Just ""),
+            ("complaintsSimplex", strEncode <$> simplex),
+            ("complaintsEmail", encodeUtf8 <$> email),
+            ("complaintsPGP", encodeUtf8 . pkURI <$> pgp),
+            ("complaintsPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
+          ]
+        hostingE Entity {name, country} =
+          [ ("hosting", Just ""),
+            ("hostingEntity", Just $ encodeUtf8 name),
+            ("hostingCountry", encodeUtf8 <$> country)
+          ]
+        server =
+          [ ("serverCountry", fmap encodeUtf8 $ serverCountry =<< information)
+          ]
+
+-- Copy-pasted from simplex-chat Simplex.Chat.Types.Preferences
+{-# INLINE timedTTLText #-}
+timedTTLText :: (Integral i, Show i) => i -> String
+timedTTLText 0 = "0 sec"
+timedTTLText ttl = do
+  let (m', s) = ttl `quotRem` 60
+      (h', m) = m' `quotRem` 60
+      (d', h) = h' `quotRem` 24
+      (mm, d) = d' `quotRem` 30
+  unwords $
+    [mms mm | mm /= 0]
+      <> [ds d | d /= 0]
+      <> [hs h | h /= 0]
+      <> [ms m | m /= 0]
+      <> [ss s | s /= 0]
+  where
+    ss s = show s <> " sec"
+    ms m = show m <> " min"
+    hs 1 = "1 hour"
+    hs h = show h <> " hours"
+    ds 1 = "1 day"
+    ds 7 = "1 week"
+    ds 14 = "2 weeks"
+    ds d = show d <> " days"
+    mms 1 = "1 month"
+    mms mm = show mm <> " months"
+
+-- | Rewrite source with provided substitutions
+render :: ByteString -> [(ByteString, Maybe ByteString)] -> ByteString
+render src = \case
+  [] -> src
+  (label, content') : rest -> render (section_ label content' src) rest
+
+-- | Rewrite section content inside @<x-label>...</x-label>@ markers.
+-- Markers are always removed when found. Closing marker is mandatory.
+-- If content is absent, whole section is removed.
+-- Section content is delegated to `item_`. If no sections found, the whole source is delegated.
+section_ :: ByteString -> Maybe ByteString -> ByteString -> ByteString
+section_ label content' src =
+  case B.breakSubstring startMarker src of
+    (_, "") -> item_ label (fromMaybe "" content') src -- no section, just replace items
+    (before, afterStart') ->
+      -- found section start, search for end too
+      case B.breakSubstring endMarker $ B.drop (B.length startMarker) afterStart' of
+        (_, "") -> error $ "missing section end: " <> show endMarker
+        (inside, next') ->
+          let next = B.drop (B.length endMarker) next'
+           in case content' of
+                Nothing -> before <> next -- collapse section
+                Just content -> before <> item_ label content inside <> section_ label content' next
+  where
+    startMarker = "<x-" <> label <> ">"
+    endMarker = "</x-" <> label <> ">"
+
+-- | Replace all occurences of @${label}@ with provided content.
+item_ :: ByteString -> ByteString -> ByteString -> ByteString
+item_ label content' src =
+  case B.breakSubstring marker src of
+    (done, "") -> done
+    (before, after') -> before <> content' <> item_ label content' (B.drop (B.length marker) after')
+  where
+    marker = "${" <> label <> "}"

apps/smp-server/web/Static/Embedded.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Static.Embedded where
+
+import Data.FileEmbed (embedDir, embedFile)
+import Data.ByteString (ByteString)
+
+indexHtml :: ByteString
+indexHtml = $(embedFile "apps/smp-server/static/index.html")
+
+linkHtml :: ByteString
+linkHtml = $(embedFile "apps/smp-server/static/link.html")
+
+mediaContent :: [(FilePath, ByteString)]
+mediaContent = $(embedDir "apps/smp-server/static/media/")

cbits/tweetnacl.c

@@ -0,0 +1,814 @@
+#include "tweetnacl.h"
+#define FOR(i,n) for (i = 0;i < n;++i)
+#define sv static void
+
+typedef unsigned char u8;
+typedef unsigned long u32;
+typedef unsigned long long u64;
+typedef long long i64;
+typedef i64 gf[16];
+// extern void randombytes(u8 *,u64);
+// fudge unused function
+#include "string.h"
+static void randombytes(u8 * dst, u64 len) {
+  memset(dst, 42, len);
+}
+
+static const u8
+  _0[16],
+  _9[32] = {9};
+static const gf
+  gf0,
+  gf1 = {1},
+  _121665 = {0xDB41,1},
+  D = {0x78a3, 0x1359, 0x4dca, 0x75eb, 0xd8ab, 0x4141, 0x0a4d, 0x0070, 0xe898, 0x7779, 0x4079, 0x8cc7, 0xfe73, 0x2b6f, 0x6cee, 0x5203},
+  D2 = {0xf159, 0x26b2, 0x9b94, 0xebd6, 0xb156, 0x8283, 0x149a, 0x00e0, 0xd130, 0xeef3, 0x80f2, 0x198e, 0xfce7, 0x56df, 0xd9dc, 0x2406},
+  X = {0xd51a, 0x8f25, 0x2d60, 0xc956, 0xa7b2, 0x9525, 0xc760, 0x692c, 0xdc5c, 0xfdd6, 0xe231, 0xc0a4, 0x53fe, 0xcd6e, 0x36d3, 0x2169},
+  Y = {0x6658, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666},
+  I = {0xa0b0, 0x4a0e, 0x1b27, 0xc4ee, 0xe478, 0xad2f, 0x1806, 0x2f43, 0xd7a7, 0x3dfb, 0x0099, 0x2b4d, 0xdf0b, 0x4fc1, 0x2480, 0x2b83};
+
+static u32 L32(u32 x,int c) { return (x << c) | ((x&0xffffffff) >> (32 - c)); }
+
+static u32 ld32(const u8 *x)
+{
+  u32 u = x[3];
+  u = (u<<8)|x[2];
+  u = (u<<8)|x[1];
+  return (u<<8)|x[0];
+}
+
+static u64 dl64(const u8 *x)
+{
+  u64 i,u=0;
+  FOR(i,8) u=(u<<8)|x[i];
+  return u;
+}
+
+sv st32(u8 *x,u32 u)
+{
+  int i;
+  FOR(i,4) { x[i] = u; u >>= 8; }
+}
+
+sv ts64(u8 *x,u64 u)
+{
+  int i;
+  for (i = 7;i >= 0;--i) { x[i] = u; u >>= 8; }
+}
+
+static int vn(const u8 *x,const u8 *y,int n)
+{
+  u32 i,d = 0;
+  FOR(i,n) d |= x[i]^y[i];
+  return (1 & ((d - 1) >> 8)) - 1;
+}
+
+int crypto_verify_16(const u8 *x,const u8 *y)
+{
+  return vn(x,y,16);
+}
+
+int crypto_verify_32(const u8 *x,const u8 *y)
+{
+  return vn(x,y,32);
+}
+
+sv core(u8 *out,const u8 *in,const u8 *k,const u8 *c,int h)
+{
+  u32 w[16],x[16],y[16],t[4];
+  int i,j,m;
+
+  FOR(i,4) {
+    x[5*i] = ld32(c+4*i);
+    x[1+i] = ld32(k+4*i);
+    x[6+i] = ld32(in+4*i);
+    x[11+i] = ld32(k+16+4*i);
+  }
+
+  FOR(i,16) y[i] = x[i];
+
+  FOR(i,20) {
+    FOR(j,4) {
+      FOR(m,4) t[m] = x[(5*j+4*m)%16];
+      t[1] ^= L32(t[0]+t[3], 7);
+      t[2] ^= L32(t[1]+t[0], 9);
+      t[3] ^= L32(t[2]+t[1],13);
+      t[0] ^= L32(t[3]+t[2],18);
+      FOR(m,4) w[4*j+(j+m)%4] = t[m];
+    }
+    FOR(m,16) x[m] = w[m];
+  }
+
+  if (h) {
+    FOR(i,16) x[i] += y[i];
+    FOR(i,4) {
+      x[5*i] -= ld32(c+4*i);
+      x[6+i] -= ld32(in+4*i);
+    }
+    FOR(i,4) {
+      st32(out+4*i,x[5*i]);
+      st32(out+16+4*i,x[6+i]);
+    }
+  } else
+    FOR(i,16) st32(out + 4 * i,x[i] + y[i]);
+}
+
+int crypto_core_salsa20(u8 *out,const u8 *in,const u8 *k,const u8 *c)
+{
+  core(out,in,k,c,0);
+  return 0;
+}
+
+int crypto_core_hsalsa20(u8 *out,const u8 *in,const u8 *k,const u8 *c)
+{
+  core(out,in,k,c,1);
+  return 0;
+}
+
+static const u8 sigma[16] = "expand 32-byte k";
+
+int crypto_stream_salsa20_xor(u8 *c,const u8 *m,u64 b,const u8 *n,const u8 *k)
+{
+  u8 z[16],x[64];
+  u32 u,i;
+  if (!b) return 0;
+  FOR(i,16) z[i] = 0;
+  FOR(i,8) z[i] = n[i];
+  while (b >= 64) {
+    crypto_core_salsa20(x,z,k,sigma);
+    FOR(i,64) c[i] = (m?m[i]:0) ^ x[i];
+    u = 1;
+    for (i = 8;i < 16;++i) {
+      u += (u32) z[i];
+      z[i] = u;
+      u >>= 8;
+    }
+    b -= 64;
+    c += 64;
+    if (m) m += 64;
+  }
+  if (b) {
+    crypto_core_salsa20(x,z,k,sigma);
+    FOR(i,b) c[i] = (m?m[i]:0) ^ x[i];
+  }
+  return 0;
+}
+
+int crypto_stream_salsa20(u8 *c,u64 d,const u8 *n,const u8 *k)
+{
+  return crypto_stream_salsa20_xor(c,0,d,n,k);
+}
+
+int crypto_stream(u8 *c,u64 d,const u8 *n,const u8 *k)
+{
+  u8 s[32];
+  crypto_core_hsalsa20(s,n,k,sigma);
+  return crypto_stream_salsa20(c,d,n+16,s);
+}
+
+int crypto_stream_xor(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
+{
+  u8 s[32];
+  crypto_core_hsalsa20(s,n,k,sigma);
+  return crypto_stream_salsa20_xor(c,m,d,n+16,s);
+}
+
+sv add1305(u32 *h,const u32 *c)
+{
+  u32 j,u = 0;
+  FOR(j,17) {
+    u += h[j] + c[j];
+    h[j] = u & 255;
+    u >>= 8;
+  }
+}
+
+static const u32 minusp[17] = {
+  5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 252
+} ;
+
+int crypto_onetimeauth(u8 *out,const u8 *m,u64 n,const u8 *k)
+{
+  u32 s,i,j,u,x[17],r[17],h[17],c[17],g[17];
+
+  FOR(j,17) r[j]=h[j]=0;
+  FOR(j,16) r[j]=k[j];
+  r[3]&=15;
+  r[4]&=252;
+  r[7]&=15;
+  r[8]&=252;
+  r[11]&=15;
+  r[12]&=252;
+  r[15]&=15;
+
+  while (n > 0) {
+    FOR(j,17) c[j] = 0;
+    for (j = 0;(j < 16) && (j < n);++j) c[j] = m[j];
+    c[j] = 1;
+    m += j; n -= j;
+    add1305(h,c);
+    FOR(i,17) {
+      x[i] = 0;
+      FOR(j,17) x[i] += h[j] * ((j <= i) ? r[i - j] : 320 * r[i + 17 - j]);
+    }
+    FOR(i,17) h[i] = x[i];
+    u = 0;
+    FOR(j,16) {
+      u += h[j];
+      h[j] = u & 255;
+      u >>= 8;
+    }
+    u += h[16]; h[16] = u & 3;
+    u = 5 * (u >> 2);
+    FOR(j,16) {
+      u += h[j];
+      h[j] = u & 255;
+      u >>= 8;
+    }
+    u += h[16]; h[16] = u;
+  }
+
+  FOR(j,17) g[j] = h[j];
+  add1305(h,minusp);
+  s = -(h[16] >> 7);
+  FOR(j,17) h[j] ^= s & (g[j] ^ h[j]);
+
+  FOR(j,16) c[j] = k[j + 16];
+  c[16] = 0;
+  add1305(h,c);
+  FOR(j,16) out[j] = h[j];
+  return 0;
+}
+
+int crypto_onetimeauth_verify(const u8 *h,const u8 *m,u64 n,const u8 *k)
+{
+  u8 x[16];
+  crypto_onetimeauth(x,m,n,k);
+  return crypto_verify_16(h,x);
+}
+
+int crypto_secretbox(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
+{
+  int i;
+  if (d < 32) return -1;
+  crypto_stream_xor(c,m,d,n,k);
+  crypto_onetimeauth(c + 16,c + 32,d - 32,c);
+  FOR(i,16) c[i] = 0;
+  return 0;
+}
+
+int crypto_secretbox_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k)
+{
+  int i;
+  u8 x[32];
+  if (d < 32) return -1;
+  crypto_stream(x,32,n,k);
+  if (crypto_onetimeauth_verify(c + 16,c + 32,d - 32,x) != 0) return -1;
+  crypto_stream_xor(m,c,d,n,k);
+  FOR(i,32) m[i] = 0;
+  return 0;
+}
+
+sv set25519(gf r, const gf a)
+{
+  int i;
+  FOR(i,16) r[i]=a[i];
+}
+
+sv car25519(gf o)
+{
+  int i;
+  i64 c;
+  FOR(i,16) {
+    o[i]+=(1LL<<16);
+    c=o[i]>>16;
+    o[(i+1)*(i<15)]+=c-1+37*(c-1)*(i==15);
+    o[i]-=c<<16;
+  }
+}
+
+sv sel25519(gf p,gf q,int b)
+{
+  i64 t,i,c=~(b-1);
+  FOR(i,16) {
+    t= c&(p[i]^q[i]);
+    p[i]^=t;
+    q[i]^=t;
+  }
+}
+
+sv pack25519(u8 *o,const gf n)
+{
+  int i,j,b;
+  gf m,t;
+  FOR(i,16) t[i]=n[i];
+  car25519(t);
+  car25519(t);
+  car25519(t);
+  FOR(j,2) {
+    m[0]=t[0]-0xffed;
+    for(i=1;i<15;i++) {
+      m[i]=t[i]-0xffff-((m[i-1]>>16)&1);
+      m[i-1]&=0xffff;
+    }
+    m[15]=t[15]-0x7fff-((m[14]>>16)&1);
+    b=(m[15]>>16)&1;
+    m[14]&=0xffff;
+    sel25519(t,m,1-b);
+  }
+  FOR(i,16) {
+    o[2*i]=t[i]&0xff;
+    o[2*i+1]=t[i]>>8;
+  }
+}
+
+static int neq25519(const gf a, const gf b)
+{
+  u8 c[32],d[32];
+  pack25519(c,a);
+  pack25519(d,b);
+  return crypto_verify_32(c,d);
+}
+
+static u8 par25519(const gf a)
+{
+  u8 d[32];
+  pack25519(d,a);
+  return d[0]&1;
+}
+
+sv unpack25519(gf o, const u8 *n)
+{
+  int i;
+  FOR(i,16) o[i]=n[2*i]+((i64)n[2*i+1]<<8);
+  o[15]&=0x7fff;
+}
+
+sv A(gf o,const gf a,const gf b)
+{
+  int i;
+  FOR(i,16) o[i]=a[i]+b[i];
+}
+
+sv Z(gf o,const gf a,const gf b)
+{
+  int i;
+  FOR(i,16) o[i]=a[i]-b[i];
+}
+
+sv M(gf o,const gf a,const gf b)
+{
+  i64 i,j,t[31];
+  FOR(i,31) t[i]=0;
+  FOR(i,16) FOR(j,16) t[i+j]+=a[i]*b[j];
+  FOR(i,15) t[i]+=38*t[i+16];
+  FOR(i,16) o[i]=t[i];
+  car25519(o);
+  car25519(o);
+}
+
+sv S(gf o,const gf a)
+{
+  M(o,a,a);
+}
+
+sv inv25519(gf o,const gf i)
+{
+  gf c;
+  int a;
+  FOR(a,16) c[a]=i[a];
+  for(a=253;a>=0;a--) {
+    S(c,c);
+    if(a!=2&&a!=4) M(c,c,i);
+  }
+  FOR(a,16) o[a]=c[a];
+}
+
+sv pow2523(gf o,const gf i)
+{
+  gf c;
+  int a;
+  FOR(a,16) c[a]=i[a];
+  for(a=250;a>=0;a--) {
+    S(c,c);
+    if(a!=1) M(c,c,i);
+  }
+  FOR(a,16) o[a]=c[a];
+}
+
+int crypto_scalarmult(u8 *q,const u8 *n,const u8 *p)
+{
+  u8 z[32];
+  i64 x[80],r,i;
+  gf a,b,c,d,e,f;
+  FOR(i,31) z[i]=n[i];
+  z[31]=(n[31]&127)|64;
+  z[0]&=248;
+  unpack25519(x,p);
+  FOR(i,16) {
+    b[i]=x[i];
+    d[i]=a[i]=c[i]=0;
+  }
+  a[0]=d[0]=1;
+  for(i=254;i>=0;--i) {
+    r=(z[i>>3]>>(i&7))&1;
+    sel25519(a,b,r);
+    sel25519(c,d,r);
+    A(e,a,c);
+    Z(a,a,c);
+    A(c,b,d);
+    Z(b,b,d);
+    S(d,e);
+    S(f,a);
+    M(a,c,a);
+    M(c,b,e);
+    A(e,a,c);
+    Z(a,a,c);
+    S(b,a);
+    Z(c,d,f);
+    M(a,c,_121665);
+    A(a,a,d);
+    M(c,c,a);
+    M(a,d,f);
+    M(d,b,x);
+    S(b,e);
+    sel25519(a,b,r);
+    sel25519(c,d,r);
+  }
+  FOR(i,16) {
+    x[i+16]=a[i];
+    x[i+32]=c[i];
+    x[i+48]=b[i];
+    x[i+64]=d[i];
+  }
+  inv25519(x+32,x+32);
+  M(x+16,x+16,x+32);
+  pack25519(q,x+16);
+  return 0;
+}
+
+int crypto_scalarmult_base(u8 *q,const u8 *n)
+{ 
+  return crypto_scalarmult(q,n,_9);
+}
+
+int crypto_box_keypair(u8 *y,u8 *x)
+{
+  randombytes(x,32);
+  return crypto_scalarmult_base(y,x);
+}
+
+int crypto_box_beforenm(u8 *k,const u8 *y,const u8 *x)
+{
+  u8 s[32];
+  crypto_scalarmult(s,x,y);
+  return crypto_core_hsalsa20(k,_0,s,sigma);
+}
+
+int crypto_box_afternm(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
+{
+  return crypto_secretbox(c,m,d,n,k);
+}
+
+int crypto_box_open_afternm(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k)
+{
+  return crypto_secretbox_open(m,c,d,n,k);
+}
+
+int crypto_box(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *y,const u8 *x)
+{
+  u8 k[32];
+  crypto_box_beforenm(k,y,x);
+  return crypto_box_afternm(c,m,d,n,k);
+}
+
+int crypto_box_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *y,const u8 *x)
+{
+  u8 k[32];
+  crypto_box_beforenm(k,y,x);
+  return crypto_box_open_afternm(m,c,d,n,k);
+}
+
+static u64 R(u64 x,int c) { return (x >> c) | (x << (64 - c)); }
+static u64 Ch(u64 x,u64 y,u64 z) { return (x & y) ^ (~x & z); }
+static u64 Maj(u64 x,u64 y,u64 z) { return (x & y) ^ (x & z) ^ (y & z); }
+static u64 Sigma0(u64 x) { return R(x,28) ^ R(x,34) ^ R(x,39); }
+static u64 Sigma1(u64 x) { return R(x,14) ^ R(x,18) ^ R(x,41); }
+static u64 sigma0(u64 x) { return R(x, 1) ^ R(x, 8) ^ (x >> 7); }
+static u64 sigma1(u64 x) { return R(x,19) ^ R(x,61) ^ (x >> 6); }
+
+static const u64 K[80] = 
+{
+  0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL,
+  0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL,
+  0xd807aa98a3030242ULL, 0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,
+  0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL,
+  0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL,
+  0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,
+  0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL,
+  0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL,
+  0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,
+  0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL,
+  0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL,
+  0xd192e819d6ef5218ULL, 0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,
+  0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL,
+  0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL,
+  0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,
+  0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL,
+  0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL,
+  0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,
+  0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL,
+  0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL
+};
+
+int crypto_hashblocks(u8 *x,const u8 *m,u64 n)
+{
+  u64 z[8],b[8],a[8],w[16],t;
+  int i,j;
+
+  FOR(i,8) z[i] = a[i] = dl64(x + 8 * i);
+
+  while (n >= 128) {
+    FOR(i,16) w[i] = dl64(m + 8 * i);
+
+    FOR(i,80) {
+      FOR(j,8) b[j] = a[j];
+      t = a[7] + Sigma1(a[4]) + Ch(a[4],a[5],a[6]) + K[i] + w[i%16];
+      b[7] = t + Sigma0(a[0]) + Maj(a[0],a[1],a[2]);
+      b[3] += t;
+      FOR(j,8) a[(j+1)%8] = b[j];
+      if (i%16 == 15)
+	FOR(j,16)
+	  w[j] += w[(j+9)%16] + sigma0(w[(j+1)%16]) + sigma1(w[(j+14)%16]);
+    }
+
+    FOR(i,8) { a[i] += z[i]; z[i] = a[i]; }
+
+    m += 128;
+    n -= 128;
+  }
+
+  FOR(i,8) ts64(x+8*i,z[i]);
+
+  return n;
+}
+
+static const u8 iv[64] = {
+  0x6a,0x09,0xe6,0x67,0xf3,0xbc,0xc9,0x08,
+  0xbb,0x67,0xae,0x85,0x84,0xca,0xa7,0x3b,
+  0x3c,0x6e,0xf3,0x72,0xfe,0x94,0xf8,0x2b,
+  0xa5,0x4f,0xf5,0x3a,0x5f,0x1d,0x36,0xf1,
+  0x51,0x0e,0x52,0x7f,0xad,0xe6,0x82,0xd1,
+  0x9b,0x05,0x68,0x8c,0x2b,0x3e,0x6c,0x1f,
+  0x1f,0x83,0xd9,0xab,0xfb,0x41,0xbd,0x6b,
+  0x5b,0xe0,0xcd,0x19,0x13,0x7e,0x21,0x79
+} ;
+
+int crypto_hash(u8 *out,const u8 *m,u64 n)
+{
+  u8 h[64],x[256];
+  u64 i,b = n;
+
+  FOR(i,64) h[i] = iv[i];
+
+  crypto_hashblocks(h,m,n);
+  m += n;
+  n &= 127;
+  m -= n;
+
+  FOR(i,256) x[i] = 0;
+  FOR(i,n) x[i] = m[i];
+  x[n] = 128;
+
+  n = 256-128*(n<112);
+  x[n-9] = b >> 61;
+  ts64(x+n-8,b<<3);
+  crypto_hashblocks(h,x,n);
+
+  FOR(i,64) out[i] = h[i];
+
+  return 0;
+}
+
+sv add(gf p[4],gf q[4])
+{
+  gf a,b,c,d,t,e,f,g,h;
+  
+  Z(a, p[1], p[0]);
+  Z(t, q[1], q[0]);
+  M(a, a, t);
+  A(b, p[0], p[1]);
+  A(t, q[0], q[1]);
+  M(b, b, t);
+  M(c, p[3], q[3]);
+  M(c, c, D2);
+  M(d, p[2], q[2]);
+  A(d, d, d);
+  Z(e, b, a);
+  Z(f, d, c);
+  A(g, d, c);
+  A(h, b, a);
+
+  M(p[0], e, f);
+  M(p[1], h, g);
+  M(p[2], g, f);
+  M(p[3], e, h);
+}
+
+sv cswap(gf p[4],gf q[4],u8 b)
+{
+  int i;
+  FOR(i,4)
+    sel25519(p[i],q[i],b);
+}
+
+sv pack(u8 *r,gf p[4])
+{
+  gf tx, ty, zi;
+  inv25519(zi, p[2]); 
+  M(tx, p[0], zi);
+  M(ty, p[1], zi);
+  pack25519(r, ty);
+  r[31] ^= par25519(tx) << 7;
+}
+
+sv scalarmult(gf p[4],gf q[4],const u8 *s)
+{
+  int i;
+  set25519(p[0],gf0);
+  set25519(p[1],gf1);
+  set25519(p[2],gf1);
+  set25519(p[3],gf0);
+  for (i = 255;i >= 0;--i) {
+    u8 b = (s[i/8]>>(i&7))&1;
+    cswap(p,q,b);
+    add(q,p);
+    add(p,p);
+    cswap(p,q,b);
+  }
+}
+
+sv scalarbase(gf p[4],const u8 *s)
+{
+  gf q[4];
+  set25519(q[0],X);
+  set25519(q[1],Y);
+  set25519(q[2],gf1);
+  M(q[3],X,Y);
+  scalarmult(p,q,s);
+}
+
+int crypto_sign_keypair(u8 *pk, u8 *sk)
+{
+  u8 d[64];
+  gf p[4];
+  int i;
+
+  randombytes(sk, 32);
+  crypto_hash(d, sk, 32);
+  d[0] &= 248;
+  d[31] &= 127;
+  d[31] |= 64;
+
+  scalarbase(p,d);
+  pack(pk,p);
+
+  FOR(i,32) sk[32 + i] = pk[i];
+  return 0;
+}
+
+static const u64 L[32] = {0xed, 0xd3, 0xf5, 0x5c, 0x1a, 0x63, 0x12, 0x58, 0xd6, 0x9c, 0xf7, 0xa2, 0xde, 0xf9, 0xde, 0x14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0x10};
+
+sv modL(u8 *r,i64 x[64])
+{
+  i64 carry,i,j;
+  for (i = 63;i >= 32;--i) {
+    carry = 0;
+    for (j = i - 32;j < i - 12;++j) {
+      x[j] += carry - 16 * x[i] * L[j - (i - 32)];
+      carry = (x[j] + 128) >> 8;
+      x[j] -= carry << 8;
+    }
+    x[j] += carry;
+    x[i] = 0;
+  }
+  carry = 0;
+  FOR(j,32) {
+    x[j] += carry - (x[31] >> 4) * L[j];
+    carry = x[j] >> 8;
+    x[j] &= 255;
+  }
+  FOR(j,32) x[j] -= carry * L[j];
+  FOR(i,32) {
+    x[i+1] += x[i] >> 8;
+    r[i] = x[i] & 255;
+  }
+}
+
+sv reduce(u8 *r)
+{
+  i64 x[64],i;
+  FOR(i,64) x[i] = (u64) r[i];
+  FOR(i,64) r[i] = 0;
+  modL(r,x);
+}
+
+int crypto_sign(u8 *sm,u64 *smlen,const u8 *m,u64 n,const u8 *sk)
+{
+  u8 d[64],h[64],r[64];
+  i64 i,j,x[64];
+  gf p[4];
+
+  crypto_hash(d, sk, 32);
+  d[0] &= 248;
+  d[31] &= 127;
+  d[31] |= 64;
+
+  *smlen = n+64;
+  FOR(i,n) sm[64 + i] = m[i];
+  FOR(i,32) sm[32 + i] = d[32 + i];
+
+  crypto_hash(r, sm+32, n+32);
+  reduce(r);
+  scalarbase(p,r);
+  pack(sm,p);
+
+  FOR(i,32) sm[i+32] = sk[i+32];
+  crypto_hash(h,sm,n + 64);
+  reduce(h);
+
+  FOR(i,64) x[i] = 0;
+  FOR(i,32) x[i] = (u64) r[i];
+  FOR(i,32) FOR(j,32) x[i+j] += h[i] * (u64) d[j];
+  modL(sm + 32,x);
+
+  return 0;
+}
+
+static int unpackneg(gf r[4],const u8 p[32])
+{
+  gf t, chk, num, den, den2, den4, den6;
+  set25519(r[2],gf1);
+  unpack25519(r[1],p);
+  S(num,r[1]);
+  M(den,num,D);
+  Z(num,num,r[2]);
+  A(den,r[2],den);
+
+  S(den2,den);
+  S(den4,den2);
+  M(den6,den4,den2);
+  M(t,den6,num);
+  M(t,t,den);
+
+  pow2523(t,t);
+  M(t,t,num);
+  M(t,t,den);
+  M(t,t,den);
+  M(r[0],t,den);
+
+  S(chk,r[0]);
+  M(chk,chk,den);
+  if (neq25519(chk, num)) M(r[0],r[0],I);
+
+  S(chk,r[0]);
+  M(chk,chk,den);
+  if (neq25519(chk, num)) return -1;
+
+  if (par25519(r[0]) == (p[31]>>7)) Z(r[0],gf0,r[0]);
+
+  M(r[3],r[0],r[1]);
+  return 0;
+}
+
+int crypto_sign_open(u8 *m,u64 *mlen,const u8 *sm,u64 n,const u8 *pk)
+{
+  int i;
+  u8 t[32],h[64];
+  gf p[4],q[4];
+
+  *mlen = -1;
+  if (n < 64) return -1;
+
+  if (unpackneg(q,pk)) return -1;
+
+  FOR(i,n) m[i] = sm[i];
+  FOR(i,32) m[i+32] = pk[i];
+  crypto_hash(h,m,n);
+  reduce(h);
+  scalarmult(p,q,h);
+
+  scalarbase(q,sm + 32);
+  add(p,q);
+  pack(t,p);
+
+  n -= 64;
+  if (crypto_verify_32(sm, t)) {
+    FOR(i,n) m[i] = 0;
+    return -1;
+  }
+
+  FOR(i,n) m[i] = sm[i + 64];
+  *mlen = n;
+  return 0;
+}

cbits/tweetnacl.h

@@ -0,0 +1,272 @@
+#ifndef TWEETNACL_H
+#define TWEETNACL_H
+#define crypto_auth_PRIMITIVE "hmacsha512256"
+#define crypto_auth crypto_auth_hmacsha512256
+#define crypto_auth_verify crypto_auth_hmacsha512256_verify
+#define crypto_auth_BYTES crypto_auth_hmacsha512256_BYTES
+#define crypto_auth_KEYBYTES crypto_auth_hmacsha512256_KEYBYTES
+#define crypto_auth_IMPLEMENTATION crypto_auth_hmacsha512256_IMPLEMENTATION
+#define crypto_auth_VERSION crypto_auth_hmacsha512256_VERSION
+#define crypto_auth_hmacsha512256_tweet_BYTES 32
+#define crypto_auth_hmacsha512256_tweet_KEYBYTES 32
+extern int crypto_auth_hmacsha512256_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
+extern int crypto_auth_hmacsha512256_tweet_verify(const unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
+#define crypto_auth_hmacsha512256_tweet_VERSION "-"
+#define crypto_auth_hmacsha512256 crypto_auth_hmacsha512256_tweet
+#define crypto_auth_hmacsha512256_verify crypto_auth_hmacsha512256_tweet_verify
+#define crypto_auth_hmacsha512256_BYTES crypto_auth_hmacsha512256_tweet_BYTES
+#define crypto_auth_hmacsha512256_KEYBYTES crypto_auth_hmacsha512256_tweet_KEYBYTES
+#define crypto_auth_hmacsha512256_VERSION crypto_auth_hmacsha512256_tweet_VERSION
+#define crypto_auth_hmacsha512256_IMPLEMENTATION "crypto_auth/hmacsha512256/tweet"
+#define crypto_box_PRIMITIVE "curve25519xsalsa20poly1305"
+#define crypto_box crypto_box_curve25519xsalsa20poly1305
+#define crypto_box_open crypto_box_curve25519xsalsa20poly1305_open
+#define crypto_box_keypair crypto_box_curve25519xsalsa20poly1305_keypair
+#define crypto_box_beforenm crypto_box_curve25519xsalsa20poly1305_beforenm
+#define crypto_box_afternm crypto_box_curve25519xsalsa20poly1305_afternm
+#define crypto_box_open_afternm crypto_box_curve25519xsalsa20poly1305_open_afternm
+#define crypto_box_PUBLICKEYBYTES crypto_box_curve25519xsalsa20poly1305_PUBLICKEYBYTES
+#define crypto_box_SECRETKEYBYTES crypto_box_curve25519xsalsa20poly1305_SECRETKEYBYTES
+#define crypto_box_BEFORENMBYTES crypto_box_curve25519xsalsa20poly1305_BEFORENMBYTES
+#define crypto_box_NONCEBYTES crypto_box_curve25519xsalsa20poly1305_NONCEBYTES
+#define crypto_box_ZEROBYTES crypto_box_curve25519xsalsa20poly1305_ZEROBYTES
+#define crypto_box_BOXZEROBYTES crypto_box_curve25519xsalsa20poly1305_BOXZEROBYTES
+#define crypto_box_IMPLEMENTATION crypto_box_curve25519xsalsa20poly1305_IMPLEMENTATION
+#define crypto_box_VERSION crypto_box_curve25519xsalsa20poly1305_VERSION
+#define crypto_box_curve25519xsalsa20poly1305_tweet_PUBLICKEYBYTES 32
+#define crypto_box_curve25519xsalsa20poly1305_tweet_SECRETKEYBYTES 32
+#define crypto_box_curve25519xsalsa20poly1305_tweet_BEFORENMBYTES 32
+#define crypto_box_curve25519xsalsa20poly1305_tweet_NONCEBYTES 24
+#define crypto_box_curve25519xsalsa20poly1305_tweet_ZEROBYTES 32
+#define crypto_box_curve25519xsalsa20poly1305_tweet_BOXZEROBYTES 16
+extern int crypto_box_curve25519xsalsa20poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *,const unsigned char *);
+extern int crypto_box_curve25519xsalsa20poly1305_tweet_open(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *,const unsigned char *);
+extern int crypto_box_curve25519xsalsa20poly1305_tweet_keypair(unsigned char *,unsigned char *);
+extern int crypto_box_curve25519xsalsa20poly1305_tweet_beforenm(unsigned char *,const unsigned char *,const unsigned char *);
+extern int crypto_box_curve25519xsalsa20poly1305_tweet_afternm(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+extern int crypto_box_curve25519xsalsa20poly1305_tweet_open_afternm(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+#define crypto_box_curve25519xsalsa20poly1305_tweet_VERSION "-"
+#define crypto_box_curve25519xsalsa20poly1305 crypto_box_curve25519xsalsa20poly1305_tweet
+#define crypto_box_curve25519xsalsa20poly1305_open crypto_box_curve25519xsalsa20poly1305_tweet_open
+#define crypto_box_curve25519xsalsa20poly1305_keypair crypto_box_curve25519xsalsa20poly1305_tweet_keypair
+#define crypto_box_curve25519xsalsa20poly1305_beforenm crypto_box_curve25519xsalsa20poly1305_tweet_beforenm
+#define crypto_box_curve25519xsalsa20poly1305_afternm crypto_box_curve25519xsalsa20poly1305_tweet_afternm
+#define crypto_box_curve25519xsalsa20poly1305_open_afternm crypto_box_curve25519xsalsa20poly1305_tweet_open_afternm
+#define crypto_box_curve25519xsalsa20poly1305_PUBLICKEYBYTES crypto_box_curve25519xsalsa20poly1305_tweet_PUBLICKEYBYTES
+#define crypto_box_curve25519xsalsa20poly1305_SECRETKEYBYTES crypto_box_curve25519xsalsa20poly1305_tweet_SECRETKEYBYTES
+#define crypto_box_curve25519xsalsa20poly1305_BEFORENMBYTES crypto_box_curve25519xsalsa20poly1305_tweet_BEFORENMBYTES
+#define crypto_box_curve25519xsalsa20poly1305_NONCEBYTES crypto_box_curve25519xsalsa20poly1305_tweet_NONCEBYTES
+#define crypto_box_curve25519xsalsa20poly1305_ZEROBYTES crypto_box_curve25519xsalsa20poly1305_tweet_ZEROBYTES
+#define crypto_box_curve25519xsalsa20poly1305_BOXZEROBYTES crypto_box_curve25519xsalsa20poly1305_tweet_BOXZEROBYTES
+#define crypto_box_curve25519xsalsa20poly1305_VERSION crypto_box_curve25519xsalsa20poly1305_tweet_VERSION
+#define crypto_box_curve25519xsalsa20poly1305_IMPLEMENTATION "crypto_box/curve25519xsalsa20poly1305/tweet"
+#define crypto_core_PRIMITIVE "salsa20"
+#define crypto_core crypto_core_salsa20
+#define crypto_core_OUTPUTBYTES crypto_core_salsa20_OUTPUTBYTES
+#define crypto_core_INPUTBYTES crypto_core_salsa20_INPUTBYTES
+#define crypto_core_KEYBYTES crypto_core_salsa20_KEYBYTES
+#define crypto_core_CONSTBYTES crypto_core_salsa20_CONSTBYTES
+#define crypto_core_IMPLEMENTATION crypto_core_salsa20_IMPLEMENTATION
+#define crypto_core_VERSION crypto_core_salsa20_VERSION
+#define crypto_core_salsa20_tweet_OUTPUTBYTES 64
+#define crypto_core_salsa20_tweet_INPUTBYTES 16
+#define crypto_core_salsa20_tweet_KEYBYTES 32
+#define crypto_core_salsa20_tweet_CONSTBYTES 16
+extern int crypto_core_salsa20_tweet(unsigned char *,const unsigned char *,const unsigned char *,const unsigned char *);
+#define crypto_core_salsa20_tweet_VERSION "-"
+#define crypto_core_salsa20 crypto_core_salsa20_tweet
+#define crypto_core_salsa20_OUTPUTBYTES crypto_core_salsa20_tweet_OUTPUTBYTES
+#define crypto_core_salsa20_INPUTBYTES crypto_core_salsa20_tweet_INPUTBYTES
+#define crypto_core_salsa20_KEYBYTES crypto_core_salsa20_tweet_KEYBYTES
+#define crypto_core_salsa20_CONSTBYTES crypto_core_salsa20_tweet_CONSTBYTES
+#define crypto_core_salsa20_VERSION crypto_core_salsa20_tweet_VERSION
+#define crypto_core_salsa20_IMPLEMENTATION "crypto_core/salsa20/tweet"
+#define crypto_core_hsalsa20_tweet_OUTPUTBYTES 32
+#define crypto_core_hsalsa20_tweet_INPUTBYTES 16
+#define crypto_core_hsalsa20_tweet_KEYBYTES 32
+#define crypto_core_hsalsa20_tweet_CONSTBYTES 16
+extern int crypto_core_hsalsa20_tweet(unsigned char *,const unsigned char *,const unsigned char *,const unsigned char *);
+#define crypto_core_hsalsa20_tweet_VERSION "-"
+#define crypto_core_hsalsa20 crypto_core_hsalsa20_tweet
+#define crypto_core_hsalsa20_OUTPUTBYTES crypto_core_hsalsa20_tweet_OUTPUTBYTES
+#define crypto_core_hsalsa20_INPUTBYTES crypto_core_hsalsa20_tweet_INPUTBYTES
+#define crypto_core_hsalsa20_KEYBYTES crypto_core_hsalsa20_tweet_KEYBYTES
+#define crypto_core_hsalsa20_CONSTBYTES crypto_core_hsalsa20_tweet_CONSTBYTES
+#define crypto_core_hsalsa20_VERSION crypto_core_hsalsa20_tweet_VERSION
+#define crypto_core_hsalsa20_IMPLEMENTATION "crypto_core/hsalsa20/tweet"
+#define crypto_hashblocks_PRIMITIVE "sha512"
+#define crypto_hashblocks crypto_hashblocks_sha512
+#define crypto_hashblocks_STATEBYTES crypto_hashblocks_sha512_STATEBYTES
+#define crypto_hashblocks_BLOCKBYTES crypto_hashblocks_sha512_BLOCKBYTES
+#define crypto_hashblocks_IMPLEMENTATION crypto_hashblocks_sha512_IMPLEMENTATION
+#define crypto_hashblocks_VERSION crypto_hashblocks_sha512_VERSION
+#define crypto_hashblocks_sha512_tweet_STATEBYTES 64
+#define crypto_hashblocks_sha512_tweet_BLOCKBYTES 128
+extern int crypto_hashblocks_sha512_tweet(unsigned char *,const unsigned char *,unsigned long long);
+#define crypto_hashblocks_sha512_tweet_VERSION "-"
+#define crypto_hashblocks_sha512 crypto_hashblocks_sha512_tweet
+#define crypto_hashblocks_sha512_STATEBYTES crypto_hashblocks_sha512_tweet_STATEBYTES
+#define crypto_hashblocks_sha512_BLOCKBYTES crypto_hashblocks_sha512_tweet_BLOCKBYTES
+#define crypto_hashblocks_sha512_VERSION crypto_hashblocks_sha512_tweet_VERSION
+#define crypto_hashblocks_sha512_IMPLEMENTATION "crypto_hashblocks/sha512/tweet"
+#define crypto_hashblocks_sha256_tweet_STATEBYTES 32
+#define crypto_hashblocks_sha256_tweet_BLOCKBYTES 64
+extern int crypto_hashblocks_sha256_tweet(unsigned char *,const unsigned char *,unsigned long long);
+#define crypto_hashblocks_sha256_tweet_VERSION "-"
+#define crypto_hashblocks_sha256 crypto_hashblocks_sha256_tweet
+#define crypto_hashblocks_sha256_STATEBYTES crypto_hashblocks_sha256_tweet_STATEBYTES
+#define crypto_hashblocks_sha256_BLOCKBYTES crypto_hashblocks_sha256_tweet_BLOCKBYTES
+#define crypto_hashblocks_sha256_VERSION crypto_hashblocks_sha256_tweet_VERSION
+#define crypto_hashblocks_sha256_IMPLEMENTATION "crypto_hashblocks/sha256/tweet"
+#define crypto_hash_PRIMITIVE "sha512"
+#define crypto_hash crypto_hash_sha512
+#define crypto_hash_BYTES crypto_hash_sha512_BYTES
+#define crypto_hash_IMPLEMENTATION crypto_hash_sha512_IMPLEMENTATION
+#define crypto_hash_VERSION crypto_hash_sha512_VERSION
+#define crypto_hash_sha512_tweet_BYTES 64
+extern int crypto_hash_sha512_tweet(unsigned char *,const unsigned char *,unsigned long long);
+#define crypto_hash_sha512_tweet_VERSION "-"
+#define crypto_hash_sha512 crypto_hash_sha512_tweet
+#define crypto_hash_sha512_BYTES crypto_hash_sha512_tweet_BYTES
+#define crypto_hash_sha512_VERSION crypto_hash_sha512_tweet_VERSION
+#define crypto_hash_sha512_IMPLEMENTATION "crypto_hash/sha512/tweet"
+#define crypto_hash_sha256_tweet_BYTES 32
+extern int crypto_hash_sha256_tweet(unsigned char *,const unsigned char *,unsigned long long);
+#define crypto_hash_sha256_tweet_VERSION "-"
+#define crypto_hash_sha256 crypto_hash_sha256_tweet
+#define crypto_hash_sha256_BYTES crypto_hash_sha256_tweet_BYTES
+#define crypto_hash_sha256_VERSION crypto_hash_sha256_tweet_VERSION
+#define crypto_hash_sha256_IMPLEMENTATION "crypto_hash/sha256/tweet"
+#define crypto_onetimeauth_PRIMITIVE "poly1305"
+#define crypto_onetimeauth crypto_onetimeauth_poly1305
+#define crypto_onetimeauth_verify crypto_onetimeauth_poly1305_verify
+#define crypto_onetimeauth_BYTES crypto_onetimeauth_poly1305_BYTES
+#define crypto_onetimeauth_KEYBYTES crypto_onetimeauth_poly1305_KEYBYTES
+#define crypto_onetimeauth_IMPLEMENTATION crypto_onetimeauth_poly1305_IMPLEMENTATION
+#define crypto_onetimeauth_VERSION crypto_onetimeauth_poly1305_VERSION
+#define crypto_onetimeauth_poly1305_tweet_BYTES 16
+#define crypto_onetimeauth_poly1305_tweet_KEYBYTES 32
+extern int crypto_onetimeauth_poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
+extern int crypto_onetimeauth_poly1305_tweet_verify(const unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
+#define crypto_onetimeauth_poly1305_tweet_VERSION "-"
+#define crypto_onetimeauth_poly1305 crypto_onetimeauth_poly1305_tweet
+#define crypto_onetimeauth_poly1305_verify crypto_onetimeauth_poly1305_tweet_verify
+#define crypto_onetimeauth_poly1305_BYTES crypto_onetimeauth_poly1305_tweet_BYTES
+#define crypto_onetimeauth_poly1305_KEYBYTES crypto_onetimeauth_poly1305_tweet_KEYBYTES
+#define crypto_onetimeauth_poly1305_VERSION crypto_onetimeauth_poly1305_tweet_VERSION
+#define crypto_onetimeauth_poly1305_IMPLEMENTATION "crypto_onetimeauth/poly1305/tweet"
+#define crypto_scalarmult_PRIMITIVE "curve25519"
+#define crypto_scalarmult crypto_scalarmult_curve25519
+#define crypto_scalarmult_base crypto_scalarmult_curve25519_base
+#define crypto_scalarmult_BYTES crypto_scalarmult_curve25519_BYTES
+#define crypto_scalarmult_SCALARBYTES crypto_scalarmult_curve25519_SCALARBYTES
+#define crypto_scalarmult_IMPLEMENTATION crypto_scalarmult_curve25519_IMPLEMENTATION
+#define crypto_scalarmult_VERSION crypto_scalarmult_curve25519_VERSION
+#define crypto_scalarmult_curve25519_tweet_BYTES 32
+#define crypto_scalarmult_curve25519_tweet_SCALARBYTES 32
+extern int crypto_scalarmult_curve25519_tweet(unsigned char *,const unsigned char *,const unsigned char *);
+extern int crypto_scalarmult_curve25519_tweet_base(unsigned char *,const unsigned char *);
+#define crypto_scalarmult_curve25519_tweet_VERSION "-"
+#define crypto_scalarmult_curve25519 crypto_scalarmult_curve25519_tweet
+#define crypto_scalarmult_curve25519_base crypto_scalarmult_curve25519_tweet_base
+#define crypto_scalarmult_curve25519_BYTES crypto_scalarmult_curve25519_tweet_BYTES
+#define crypto_scalarmult_curve25519_SCALARBYTES crypto_scalarmult_curve25519_tweet_SCALARBYTES
+#define crypto_scalarmult_curve25519_VERSION crypto_scalarmult_curve25519_tweet_VERSION
+#define crypto_scalarmult_curve25519_IMPLEMENTATION "crypto_scalarmult/curve25519/tweet"
+#define crypto_secretbox_PRIMITIVE "xsalsa20poly1305"
+#define crypto_secretbox crypto_secretbox_xsalsa20poly1305
+#define crypto_secretbox_open crypto_secretbox_xsalsa20poly1305_open
+#define crypto_secretbox_KEYBYTES crypto_secretbox_xsalsa20poly1305_KEYBYTES
+#define crypto_secretbox_NONCEBYTES crypto_secretbox_xsalsa20poly1305_NONCEBYTES
+#define crypto_secretbox_ZEROBYTES crypto_secretbox_xsalsa20poly1305_ZEROBYTES
+#define crypto_secretbox_BOXZEROBYTES crypto_secretbox_xsalsa20poly1305_BOXZEROBYTES
+#define crypto_secretbox_IMPLEMENTATION crypto_secretbox_xsalsa20poly1305_IMPLEMENTATION
+#define crypto_secretbox_VERSION crypto_secretbox_xsalsa20poly1305_VERSION
+#define crypto_secretbox_xsalsa20poly1305_tweet_KEYBYTES 32
+#define crypto_secretbox_xsalsa20poly1305_tweet_NONCEBYTES 24
+#define crypto_secretbox_xsalsa20poly1305_tweet_ZEROBYTES 32
+#define crypto_secretbox_xsalsa20poly1305_tweet_BOXZEROBYTES 16
+extern int crypto_secretbox_xsalsa20poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+extern int crypto_secretbox_xsalsa20poly1305_tweet_open(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+#define crypto_secretbox_xsalsa20poly1305_tweet_VERSION "-"
+#define crypto_secretbox_xsalsa20poly1305 crypto_secretbox_xsalsa20poly1305_tweet
+#define crypto_secretbox_xsalsa20poly1305_open crypto_secretbox_xsalsa20poly1305_tweet_open
+#define crypto_secretbox_xsalsa20poly1305_KEYBYTES crypto_secretbox_xsalsa20poly1305_tweet_KEYBYTES
+#define crypto_secretbox_xsalsa20poly1305_NONCEBYTES crypto_secretbox_xsalsa20poly1305_tweet_NONCEBYTES
+#define crypto_secretbox_xsalsa20poly1305_ZEROBYTES crypto_secretbox_xsalsa20poly1305_tweet_ZEROBYTES
+#define crypto_secretbox_xsalsa20poly1305_BOXZEROBYTES crypto_secretbox_xsalsa20poly1305_tweet_BOXZEROBYTES
+#define crypto_secretbox_xsalsa20poly1305_VERSION crypto_secretbox_xsalsa20poly1305_tweet_VERSION
+#define crypto_secretbox_xsalsa20poly1305_IMPLEMENTATION "crypto_secretbox/xsalsa20poly1305/tweet"
+#define crypto_sign_PRIMITIVE "ed25519"
+#define crypto_sign crypto_sign_ed25519
+#define crypto_sign_open crypto_sign_ed25519_open
+#define crypto_sign_keypair crypto_sign_ed25519_keypair
+#define crypto_sign_BYTES crypto_sign_ed25519_BYTES
+#define crypto_sign_PUBLICKEYBYTES crypto_sign_ed25519_PUBLICKEYBYTES
+#define crypto_sign_SECRETKEYBYTES crypto_sign_ed25519_SECRETKEYBYTES
+#define crypto_sign_IMPLEMENTATION crypto_sign_ed25519_IMPLEMENTATION
+#define crypto_sign_VERSION crypto_sign_ed25519_VERSION
+#define crypto_sign_ed25519_tweet_BYTES 64
+#define crypto_sign_ed25519_tweet_PUBLICKEYBYTES 32
+#define crypto_sign_ed25519_tweet_SECRETKEYBYTES 64
+extern int crypto_sign_ed25519_tweet(unsigned char *,unsigned long long *,const unsigned char *,unsigned long long,const unsigned char *);
+extern int crypto_sign_ed25519_tweet_open(unsigned char *,unsigned long long *,const unsigned char *,unsigned long long,const unsigned char *);
+extern int crypto_sign_ed25519_tweet_keypair(unsigned char *,unsigned char *);
+#define crypto_sign_ed25519_tweet_VERSION "-"
+#define crypto_sign_ed25519 crypto_sign_ed25519_tweet
+#define crypto_sign_ed25519_open crypto_sign_ed25519_tweet_open
+#define crypto_sign_ed25519_keypair crypto_sign_ed25519_tweet_keypair
+#define crypto_sign_ed25519_BYTES crypto_sign_ed25519_tweet_BYTES
+#define crypto_sign_ed25519_PUBLICKEYBYTES crypto_sign_ed25519_tweet_PUBLICKEYBYTES
+#define crypto_sign_ed25519_SECRETKEYBYTES crypto_sign_ed25519_tweet_SECRETKEYBYTES
+#define crypto_sign_ed25519_VERSION crypto_sign_ed25519_tweet_VERSION
+#define crypto_sign_ed25519_IMPLEMENTATION "crypto_sign/ed25519/tweet"
+#define crypto_stream_PRIMITIVE "xsalsa20"
+#define crypto_stream crypto_stream_xsalsa20
+#define crypto_stream_xor crypto_stream_xsalsa20_xor
+#define crypto_stream_KEYBYTES crypto_stream_xsalsa20_KEYBYTES
+#define crypto_stream_NONCEBYTES crypto_stream_xsalsa20_NONCEBYTES
+#define crypto_stream_IMPLEMENTATION crypto_stream_xsalsa20_IMPLEMENTATION
+#define crypto_stream_VERSION crypto_stream_xsalsa20_VERSION
+#define crypto_stream_xsalsa20_tweet_KEYBYTES 32
+#define crypto_stream_xsalsa20_tweet_NONCEBYTES 24
+extern int crypto_stream_xsalsa20_tweet(unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+extern int crypto_stream_xsalsa20_tweet_xor(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+#define crypto_stream_xsalsa20_tweet_VERSION "-"
+#define crypto_stream_xsalsa20 crypto_stream_xsalsa20_tweet
+#define crypto_stream_xsalsa20_xor crypto_stream_xsalsa20_tweet_xor
+#define crypto_stream_xsalsa20_KEYBYTES crypto_stream_xsalsa20_tweet_KEYBYTES
+#define crypto_stream_xsalsa20_NONCEBYTES crypto_stream_xsalsa20_tweet_NONCEBYTES
+#define crypto_stream_xsalsa20_VERSION crypto_stream_xsalsa20_tweet_VERSION
+#define crypto_stream_xsalsa20_IMPLEMENTATION "crypto_stream/xsalsa20/tweet"
+#define crypto_stream_salsa20_tweet_KEYBYTES 32
+#define crypto_stream_salsa20_tweet_NONCEBYTES 8
+extern int crypto_stream_salsa20_tweet(unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+extern int crypto_stream_salsa20_tweet_xor(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
+#define crypto_stream_salsa20_tweet_VERSION "-"
+#define crypto_stream_salsa20 crypto_stream_salsa20_tweet
+#define crypto_stream_salsa20_xor crypto_stream_salsa20_tweet_xor
+#define crypto_stream_salsa20_KEYBYTES crypto_stream_salsa20_tweet_KEYBYTES
+#define crypto_stream_salsa20_NONCEBYTES crypto_stream_salsa20_tweet_NONCEBYTES
+#define crypto_stream_salsa20_VERSION crypto_stream_salsa20_tweet_VERSION
+#define crypto_stream_salsa20_IMPLEMENTATION "crypto_stream/salsa20/tweet"
+#define crypto_verify_PRIMITIVE "16"
+#define crypto_verify crypto_verify_16
+#define crypto_verify_BYTES crypto_verify_16_BYTES
+#define crypto_verify_IMPLEMENTATION crypto_verify_16_IMPLEMENTATION
+#define crypto_verify_VERSION crypto_verify_16_VERSION
+#define crypto_verify_16_tweet_BYTES 16
+extern int crypto_verify_16_tweet(const unsigned char *,const unsigned char *);
+#define crypto_verify_16_tweet_VERSION "-"
+#define crypto_verify_16 crypto_verify_16_tweet
+#define crypto_verify_16_BYTES crypto_verify_16_tweet_BYTES
+#define crypto_verify_16_VERSION crypto_verify_16_tweet_VERSION
+#define crypto_verify_16_IMPLEMENTATION "crypto_verify/16/tweet"
+#define crypto_verify_32_tweet_BYTES 32
+extern int crypto_verify_32_tweet(const unsigned char *,const unsigned char *);
+#define crypto_verify_32_tweet_VERSION "-"
+#define crypto_verify_32 crypto_verify_32_tweet
+#define crypto_verify_32_BYTES crypto_verify_32_tweet_BYTES
+#define crypto_verify_32_VERSION crypto_verify_32_tweet_VERSION
+#define crypto_verify_32_IMPLEMENTATION "crypto_verify/32/tweet"
+#endif

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.8.0.3
+version: 5.8.0.10
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -22,6 +22,9 @@ extra-source-files:
   - CHANGELOG.md
   - cbits/sha512.h
   - cbits/sntrup761.h
+  - cbits/tweetnacl.h
+  - apps/smp-server/static/*.html
+  - apps/smp-server/static/media/*
 
 dependencies:
   - aeson == 2.2.*
@@ -85,6 +88,9 @@ flags:
     manual: True
     default: True
 
+# cpp-options:
+#   - -Dslow_servers
+
 when:
   - condition: flag(swift)
     cpp-options:
@@ -105,15 +111,22 @@ library:
   c-sources:
     - cbits/sha512.c
     - cbits/sntrup761.c
+    - cbits/tweetnacl.c
   include-dirs: cbits
   extra-libraries: crypto
 
 executables:
   smp-server:
-    source-dirs: apps/smp-server
+    source-dirs:
+    - apps/smp-server
+    - apps/smp-server/web
     main: Main.hs
     dependencies:
+      - file-embed
       - simplexmq
+      - wai-app-static
+      - warp
+      - warp-tls
     ghc-options:
       - -threaded
       - -rtsopts
@@ -177,13 +190,31 @@ tests:
 
 ghc-options:
   # - -haddock
-  - -Wall
+  - -Weverything
+  - -Wno-missing-exported-signatures
+  - -Wno-missing-import-lists
+  - -Wno-missed-specialisations
+  - -Wno-all-missed-specialisations
+  - -Wno-unsafe
+  - -Wno-safe
+  - -Wno-missing-local-signatures
+  - -Wno-missing-kind-signatures
+  - -Wno-missing-deriving-strategies
+  - -Wno-monomorphism-restriction
+  - -Wno-prepositive-qualified-module
+  - -Wno-unused-packages
+  - -Wno-implicit-prelude
+  - -Wno-missing-safe-haskell-mode
+  - -Wno-missing-export-lists
+  - -Wno-partial-fields
   - -Wcompat
+  - -Werror=incomplete-record-updates
   - -Werror=incomplete-patterns
+  - -Werror=incomplete-uni-patterns
   - -Werror=missing-methods
+  - -Werror=tabs
   - -Wredundant-constraints
   - -Wincomplete-record-updates
-  - -Wincomplete-uni-patterns
   - -Wunused-type-patterns
   - -O2
 

rfcs/2024-03-20-server-metadata.md

@@ -52,8 +52,8 @@ source_code: https://github.com/simplex-chat/simplexmq
 
 # We should split this document to the model one, where specific parameters will be external to the document,
 # and specific to us, so that relay operators can adopt our recommended policy and publish any amendments separately.
-conditions: https://github.com/simplex-chat/simplex-chat/blob/_archived-ep/ios-file-provider/PRIVACY.md
-# conditions_amendments: link
+usage_conditions: https://github.com/simplex-chat/simplex-chat/blob/_archived-ep/ios-file-provider/PRIVACY.md
+# condition_amendments: link
 
 server_country: SE
 operator: SimpleX Chat Ltd.
@@ -62,9 +62,9 @@ website: https://simplex.chat
 admin_simplex: administrative SimpleX address
 admin_email: [email protected]
 admin_pgp: PGP key
-feedback_simplex: SimpleX address for feedback, comments and complaints
-feedback_email: [email protected]
-feedback_pgp: PGP key
+complaints_simplex: SimpleX address for feedback, comments and complaints
+complaints_email: [email protected]
+complaints_pgp: PGP key
 hosting: Linode / Akamai Inc.
 hosting_country: US
 ```
@@ -89,20 +89,27 @@ data ServerHandshake = ServerHandshake
   }
 
 data ServerInformation = ServerInformation
-  { -- below is based on the existing server configuration
-    persistence :: SMPServerPersistenceMode,
+  { config :: ServerPublicConfig,
+    info :: ServerPublicInfo
+  }
+
+-- based on server configuration
+data ServerPublicConfig = ServerPublicConfig
+  { persistence :: SMPServerPersistenceMode,
     messageExpiration :: Int,
     statsEnabled :: Bool,
     newQueuesAllowed :: Bool,
-    basicAuthEnabled :: Bool, -- server is private if enabled
-    -- below is based on INFORMATION section of INI file
-    sourceCode :: Text, -- note that this property is not optional, in line with AGPLv3 license
-    -- all below properties are optional, except entity name MUST be present if any entity country is present
+    basicAuthEnabled :: Bool -- server is private if enabled
+  }
+
+-- based on INFORMATION section of INI file
+data ServerPublicInfo = ServerPublicInfo
+  { sourceCode :: Text, -- note that this property is not optional, in line with AGPLv3 license
     conditions :: Maybe ServerConditions,
     operator :: Maybe Entity,
     website :: Maybe Text,
-    admin :: Maybe ServerContactAddress,
-    feedback :: Maybe ServerContactAddress,
+    adminContacts :: Maybe ServerContactAddress,
+    complaintsContacts :: Maybe ServerContactAddress,
     hosting :: Maybe Entity,
     serverCountry :: Maybe Text
   }

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        5.8.0.3
+version:        5.8.0.10
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -28,6 +28,34 @@ extra-source-files:
     CHANGELOG.md
     cbits/sha512.h
     cbits/sntrup761.h
+    cbits/tweetnacl.h
+    apps/smp-server/static/index.html
+    apps/smp-server/static/link.html
+    apps/smp-server/static/media/apk_icon.png
+    apps/smp-server/static/media/apple_store.svg
+    apps/smp-server/static/media/contact.js
+    apps/smp-server/static/media/contact_page_mobile.png
+    apps/smp-server/static/media/f_droid.svg
+    apps/smp-server/static/media/favicon.ico
+    apps/smp-server/static/media/GilroyBold.woff2
+    apps/smp-server/static/media/GilroyLight.woff2
+    apps/smp-server/static/media/GilroyMedium.woff2
+    apps/smp-server/static/media/GilroyRegular.woff2
+    apps/smp-server/static/media/GilroyRegularItalic.woff2
+    apps/smp-server/static/media/google_play.svg
+    apps/smp-server/static/media/logo-dark.png
+    apps/smp-server/static/media/logo-light.png
+    apps/smp-server/static/media/logo-symbol-dark.svg
+    apps/smp-server/static/media/logo-symbol-light.svg
+    apps/smp-server/static/media/moon.svg
+    apps/smp-server/static/media/qrcode.js
+    apps/smp-server/static/media/script.js
+    apps/smp-server/static/media/style.css
+    apps/smp-server/static/media/sun.svg
+    apps/smp-server/static/media/swiper-bundle.min.css
+    apps/smp-server/static/media/swiper-bundle.min.js
+    apps/smp-server/static/media/tailwind.css
+    apps/smp-server/static/media/testflight.png
 
 flag swift
   description: Enable swift JSON format
@@ -113,6 +141,7 @@ library
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.File
       Simplex.Messaging.Crypto.Lazy
+      Simplex.Messaging.Crypto.NaCl.Bindings
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Crypto.SNTRUP761
       Simplex.Messaging.Crypto.SNTRUP761.Bindings
@@ -140,10 +169,12 @@ library
       Simplex.Messaging.Server.Control
       Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.Expiration
+      Simplex.Messaging.Server.Information
       Simplex.Messaging.Server.Main
       Simplex.Messaging.Server.MsgStore
       Simplex.Messaging.Server.MsgStore.STM
       Simplex.Messaging.Server.QueueStore
+      Simplex.Messaging.Server.QueueStore.QueueInfo
       Simplex.Messaging.Server.QueueStore.STM
       Simplex.Messaging.Server.Stats
       Simplex.Messaging.Server.StoreLog
@@ -175,12 +206,13 @@ library
       src
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2
   include-dirs:
       cbits
   c-sources:
       cbits/sha512.c
       cbits/sntrup761.c
+      cbits/tweetnacl.c
   extra-libraries:
       crypto
   build-depends:
@@ -256,7 +288,7 @@ executable ntf-server
       apps/ntf-server
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -331,7 +363,7 @@ executable smp-agent
       apps/smp-agent
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -401,12 +433,15 @@ executable smp-agent
 executable smp-server
   main-is: Main.hs
   other-modules:
+      Static
+      Static.Embedded
       Paths_simplexmq
   hs-source-dirs:
       apps/smp-server
+      apps/smp-server/web
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -428,6 +463,7 @@ executable smp-server
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
+    , file-embed
     , filepath ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
@@ -456,6 +492,9 @@ executable smp-server
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , wai-app-static
+    , warp
+    , warp-tls
     , websockets ==0.12.*
     , yaml ==0.11.*
     , zstd ==0.1.3.*
@@ -481,7 +520,7 @@ executable xftp
       apps/xftp
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -556,7 +595,7 @@ executable xftp-server
       apps/xftp-server
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2 -threaded -rtsopts
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -664,7 +703,7 @@ test-suite simplexmq-test
       tests
   default-extensions:
       StrictData
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=missing-methods -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
   build-depends:
       HUnit ==1.6.*
     , QuickCheck ==2.14.*

src/Simplex/FileTransfer/Client.hs

@@ -41,7 +41,6 @@ import Simplex.Messaging.Client
     transportClientConfig,
     unexpectedResponse,
   )
-import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding (smpDecode, smpEncode)
@@ -53,7 +52,7 @@ import Simplex.Messaging.Protocol
     RecipientId,
     SenderId,
   )
-import Simplex.Messaging.Transport (ALPN, THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
+import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Client
@@ -117,8 +116,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
   logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
   thParams@THandleParams {thVersion} <- case sessionALPN of
     Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
-    Nothing -> pure thParams0
-    _ -> throwError $ PCETransportError TEVersion
+    _ -> pure thParams0
   logDebug $ "Client negotiated protocol: " <> tshow thVersion
   let c = XFTPClient {http2Client, thParams, transportSession, config}
   atomically $ writeTVar clientVar $ Just c
@@ -136,15 +134,15 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
     getServerHandshake = do
       let helloReq = H.requestNoBody "POST" "/" []
       HTTP2Response {respBody = HTTP2Body {bodyHead = shsBody}} <-
-        liftError' (const $ PCEResponseError HANDSHAKE) $ sendRequest c helloReq Nothing
-      liftHS . smpDecode =<< liftHS (C.unPad shsBody)
+        liftError' xftpClientError $ sendRequest c helloReq Nothing
+      liftTransportErr (TEHandshake PARSE) . smpDecode =<< liftTransportErr TEBadBlock (C.unPad shsBody)
     processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionRangeXFTP, C.PublicKeyX25519)
     processServerHandshake XFTPServerHandshake {xftpVersionRange, sessionId = serverSessId, authPubKey = serverAuth} = do
-      unless (sessionId == serverSessId) $ throwError $ PCEResponseError SESSION
+      unless (sessionId == serverSessId) $ throwError $ PCETransportError TEBadSession
       case xftpVersionRange `compatibleVRange` serverVRange of
         Nothing -> throwError $ PCETransportError TEVersion
         Just (Compatible vr) ->
-          fmap (vr,) . liftHS $ do
+          fmap (vr,) . liftTransportErr (TEHandshake BAD_AUTH) $ do
             let (X.CertificateChain cert, exact) = serverAuth
             case cert of
               [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
@@ -153,11 +151,11 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
             C.x509ToPublic (pubKey, []) >>= C.pubKey
     sendClientHandshake :: XFTPClientHandshake -> ExceptT XFTPClientError IO ()
     sendClientHandshake chs = do
-      chs' <- liftHS $ C.pad (smpEncode chs) xftpBlockSize
+      chs' <- liftTransportErr TELargeMsg $ C.pad (smpEncode chs) xftpBlockSize
       let chsReq = H.requestBuilder "POST" "/" [] $ byteString chs'
-      HTTP2Response {respBody = HTTP2Body {bodyHead}} <- liftError' (const $ PCEResponseError HANDSHAKE) $ sendRequest c chsReq Nothing
-      unless (B.null bodyHead) $ throwError $ PCEResponseError HANDSHAKE
-    liftHS = liftEitherWith (const $ PCEResponseError HANDSHAKE)
+      HTTP2Response {respBody = HTTP2Body {bodyHead}} <- liftError' xftpClientError $ sendRequest c chsReq Nothing
+      unless (B.null bodyHead) $ throwError $ PCETransportError TEBadBlock
+    liftTransportErr e = liftEitherWith (const $ PCETransportError e)
 
 closeXFTPClient :: XFTPClient -> IO ()
 closeXFTPClient XFTPClient {http2Client} = closeHTTP2Client http2Client
@@ -217,7 +215,7 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
       forM_ chunkSpec_ $ \XFTPChunkSpec {filePath, chunkOffset, chunkSize} ->
         withFile filePath ReadMode $ \h -> do
           hSeek h AbsoluteSeek $ fromIntegral chunkOffset
-          hSendFile h send $ fromIntegral chunkSize
+          hSendFile h send chunkSize
       done
 
 createXFTPChunk ::

src/Simplex/FileTransfer/Client/Agent.hs

@@ -18,7 +18,6 @@ import Data.Text.Encoding (decodeUtf8)
 import Simplex.FileTransfer.Client
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientError (..), temporaryClientError)
-import Simplex.Messaging.Client.Agent ()
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
 import Simplex.Messaging.TMap (TMap)

src/Simplex/FileTransfer/Client/Main.hs

@@ -332,7 +332,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
           (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
           rKeys <- atomically $ L.fromList <$> replicateM numRecipients (C.generateAuthKeyPair C.SEd25519 g)
           digest <- liftIO $ getChunkDigest chunkSpec
-          let ch = FileInfo {sndKey, size = fromIntegral chunkSize, digest}
+          let ch = FileInfo {sndKey, size = chunkSize, digest}
           c <- withRetry retryCount $ getXFTPServerClient a xftpServer
           (sndId, rIds) <- withRetry retryCount $ createXFTPChunk c spKey ch (L.map fst rKeys) auth
           withReconnect a xftpServer retryCount $ \c' -> uploadXFTPChunk c' spKey sndId chunkSpec
@@ -344,7 +344,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
             when verbose $ putStrLn ""
           let recipients = L.toList $ L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys
               replicas = [SentFileChunkReplica {server = xftpServer, recipients}]
-          pure (chunkNo, SentFileChunk {chunkNo, sndId, sndPrivateKey = spKey, chunkSize = FileSize $ fromIntegral chunkSize, digest = FileDigest digest, replicas})
+          pure (chunkNo, SentFileChunk {chunkNo, sndId, sndPrivateKey = spKey, chunkSize = FileSize chunkSize, digest = FileDigest digest, replicas})
         getXFTPServer :: TVar StdGen -> NonEmpty XFTPServerWithAuth -> IO XFTPServerWithAuth
         getXFTPServer gen = \case
           srv :| [] -> pure srv
@@ -563,7 +563,7 @@ prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) c
   where
     addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
     addSpec (chunkOffset, specs) sz =
-      let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = fromIntegral sz}
+      let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz}
        in (chunkOffset + fromIntegral sz, spec : specs)
 
 getEncPath :: MonadIO m => Maybe FilePath -> String -> m FilePath

src/Simplex/FileTransfer/Server.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -67,6 +68,9 @@ import Simplex.Messaging.Version
 import System.Exit (exitFailure)
 import System.FilePath ((</>))
 import System.IO (hPrint, hPutStrLn, universalNewlineMode)
+#ifdef slow_servers
+import System.Random (getStdRandom, randomR)
+#endif
 import UnliftIO
 import UnliftIO.Concurrent (threadDelay)
 import UnliftIO.Directory (doesFileExist, removeFile, renameFile)
@@ -138,6 +142,9 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
           let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
           let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
           shs <- encodeXftp hs
+#ifdef slow_servers
+          lift randomDelay
+#endif
           liftIO . sendResponse $ H.responseBuilder N.ok200 [] shs
           pure Nothing
         processClientHandshake pk = do
@@ -151,6 +158,9 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
               let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
                   thParams = thParams0 {thAuth = Just auth, thVersion = v, thServerVRange = vr}
               atomically $ TM.insert sessionId (HandshakeAccepted thParams) sessions
+#ifdef slow_servers
+              lift randomDelay
+#endif
               liftIO . sendResponse $ H.responseNoBody N.ok200 []
               pure Nothing
             Nothing -> throwError HANDSHAKE
@@ -315,6 +325,9 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
   where
     sendXFTPResponse (corrId, fId, resp) serverFile_ = do
       let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
+#ifdef slow_servers
+      randomDelay
+#endif
       liftIO $ sendResponse $ H.responseStreaming N.ok200 [] $ streamBody t_
       where
         streamBody t_ send done = do
@@ -326,9 +339,18 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
               send $ byteString t
               -- timeout sending file in the same way as receiving
               forM_ serverFile_ $ \ServerFile {filePath, fileSize, sbState} -> do
-                withFile filePath ReadMode $ \h -> sendEncFile h send sbState (fromIntegral fileSize)
+                withFile filePath ReadMode $ \h -> sendEncFile h send sbState fileSize
           done
 
+#ifdef slow_servers
+randomDelay :: M ()
+randomDelay = do
+  d <- asks $ responseDelay . config
+  when (d > 0) $ do
+    pc <- getStdRandom (randomR (-200, 200))
+    threadDelay $ (d * (1000 + pc)) `div` 1000
+#endif
+
 data VerificationResult = VRVerified XFTPRequest | VRFailed
 
 verifyXFTPTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> XFTPFileId -> FileCmd -> M VerificationResult
@@ -457,7 +479,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
                 pure $ FRErr e
           receiveChunk spec = do
             t <- asks $ fileTimeout . config
-            liftIO $ fromMaybe (Left TIMEOUT) <$> timeout t (runExceptT (receiveFile getBody spec) `catchAll_` pure (Left FILE_IO))
+            liftIO $ fromMaybe (Left TIMEOUT) <$> timeout t (runExceptT $ receiveFile getBody spec)
     sendServerFile :: FileRec -> RcvPublicDhKey -> M (FileResponse, Maybe ServerFile)
     sendServerFile FileRec {senderId, filePath, fileInfo = FileInfo {size}} rDhKey = do
       readTVarIO filePath >>= \case

src/Simplex/FileTransfer/Server/Env.hs

@@ -69,7 +69,8 @@ data XFTPServerConfig = XFTPServerConfig
     logStatsStartTime :: Int64,
     serverStatsLogFile :: FilePath,
     serverStatsBackupFile :: Maybe FilePath,
-    transportConfig :: TransportServerConfig
+    transportConfig :: TransportServerConfig,
+    responseDelay :: Int
   }
 
 defaultInactiveClientExpiration :: ExpirationConfig

src/Simplex/FileTransfer/Server/Main.hs

@@ -7,13 +7,13 @@
 
 module Simplex.FileTransfer.Server.Main where
 
-import qualified Data.ByteString.Char8 as B
 import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
 import Simplex.FileTransfer.Chunks
@@ -29,6 +29,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
+import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -69,7 +70,7 @@ xftpServerCLI cfgPath logPath = do
       fp <- createServerX509 cfgPath x509cfg
       let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
           srv = ProtoServerWithAuth (XFTPServer [THDomainName host] "" (C.KeyHash fp)) Nothing
-      writeFile iniFile $ iniFileContent host
+      T.writeFile iniFile $ iniFileContent host
       putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
       warnCAPrivateKeyFile cfgPath x509cfg
       printServiceInfo serverVersion srv
@@ -83,7 +84,7 @@ xftpServerCLI cfgPath logPath = do
           \# Log is compacted on start (deleted objects are removed).\n"
             <> ("enable: " <> onOff enableStoreLog <> "\n\n")
             <> "# Expire files after the specified number of hours.\n"
-            <> ("expire_files_hours: " <> show defFileExpirationHours <> "\n\n")
+            <> ("expire_files_hours: " <> tshow defFileExpirationHours <> "\n\n")
             <> "log_stats: off\n\
                \\n\
                \[AUTH]\n\
@@ -102,20 +103,20 @@ xftpServerCLI cfgPath logPath = do
                \# control_port_user_password:\n\
                \[TRANSPORT]\n\
                \# host is only used to print server address on start\n"
-            <> ("host: " <> host <> "\n")
-            <> ("port: " <> defaultServerPort <> "\n")
+            <> ("host: " <> T.pack host <> "\n")
+            <> ("port: " <> T.pack defaultServerPort <> "\n")
             <> "log_tls_errors: off\n\
                \# control_port: 5226\n\
                \\n\
                \[FILES]\n"
-            <> ("path: " <> filesPath <> "\n")
-            <> ("storage_quota: " <> B.unpack (strEncode fileSizeQuota) <> "\n")
+            <> ("path: " <> T.pack filesPath <> "\n")
+            <> ("storage_quota: " <> safeDecodeUtf8 (strEncode fileSizeQuota) <> "\n")
             <> "\n\
                \[INACTIVE_CLIENTS]\n\
                \# TTL and interval to check inactive clients\n\
                \disconnect: off\n"
-            <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-            <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
+            <> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
+            <> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
     runServer ini = do
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
@@ -165,7 +166,7 @@ xftpServerCLI cfgPath logPath = do
                   defaultFileExpiration
                     { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini
                     },
-              fileTimeout = 10 * 60 * 1000000, -- 10 mins to send 4mb chunk
+              fileTimeout = 5 * 60 * 1000000, -- 5 mins to send 4mb chunk
               inactiveClientExpiration =
                 settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
                   $> ExpirationConfig
@@ -184,7 +185,8 @@ xftpServerCLI cfgPath logPath = do
                 defaultTransportServerConfig
                   { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
                     alpn = Just supportedXFTPhandshakes
-                  }
+                  },
+              responseDelay = 0
             }
 
 data CliCommand

src/Simplex/FileTransfer/Transport.hs

@@ -34,6 +34,7 @@ where
 
 import Control.Applicative ((<|>))
 import qualified Control.Exception as E
+import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
@@ -46,8 +47,10 @@ import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Functor (($>))
 import Data.Word (Word16, Word32)
 import qualified Data.X509 as X
+import Network.HTTP2.Client (HTTP2Error)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
@@ -56,7 +59,7 @@ import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol (CommandError)
 import Simplex.Messaging.Transport (SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 import System.IO (Handle, IOMode (..), withFile)
@@ -145,9 +148,14 @@ sendEncFile h send = go
         go sbState' $ sz - fromIntegral (B.length ch)
 
 receiveFile :: (Int -> IO ByteString) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
-receiveFile getBody = receiveFile_ receive
+receiveFile getBody chunk = ExceptT $ runExceptT (receiveFile_ receive chunk) `E.catches` handlers
   where
     receive h sz = hReceiveFile getBody h sz >>= \sz' -> pure $ if sz' == 0 then Right () else Left SIZE
+    handlers =
+      [ E.Handler $ \(e :: HTTP2Error) -> logWarn (err e) $> Left TIMEOUT,
+        E.Handler $ \(e :: E.SomeException) -> logError (err e) $> Left FILE_IO
+      ]
+    err e = "receiveFile error: " <> tshow e
 
 receiveEncFile :: (Int -> IO ByteString) -> LC.SbState -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
 receiveEncFile getBody = receiveFile_ . receive
@@ -213,7 +221,7 @@ data XFTPErrorType
     HAS_FILE
   | -- | file IO error
     FILE_IO
-  | -- | file sending timeout
+  | -- | file sending or receiving timeout
     TIMEOUT
   | -- | bad redirect data
     REDIRECT {redirectError :: String}

src/Simplex/Messaging/Agent.hs

@@ -70,6 +70,7 @@ module Simplex.Messaging.Agent
     sendMessages,
     sendMessagesB,
     ackMessage,
+    getConnectionQueueInfo,
     switchConnection,
     abortConnectionSwitch,
     synchronizeRatchet,
@@ -82,8 +83,6 @@ module Simplex.Messaging.Agent
     testProtocolServer,
     setNtfServers,
     setNetworkConfig,
-    getNetworkConfig,
-    getNetworkConfig',
     setUserNetworkInfo,
     reconnectAllServers,
     registerNtfToken,
@@ -120,10 +119,11 @@ module Simplex.Messaging.Agent
   )
 where
 
-import Control.Logger.Simple (logError, logInfo, showText)
+import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson as J
 import Data.Bifunctor (bimap, first, second)
@@ -140,6 +140,8 @@ import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock
@@ -173,6 +175,7 @@ import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
 import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), EntityId, ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC, XFTPServerWithAuth)
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion, THandleParams (sessionId))
@@ -356,18 +359,22 @@ sendMessage c = withAgentEnv c .:: sendMessage' c
 type MsgReq = (ConnId, PQEncryption, MsgFlags, MsgBody)
 
 -- | Send multiple messages to different connections (SEND command)
-sendMessages :: AgentClient -> [MsgReq] -> IO [Either AgentErrorType (AgentMsgId, PQEncryption)]
-sendMessages c = withAgentEnv' c . sendMessages' c
+sendMessages :: AgentClient -> [MsgReq] -> AE [Either AgentErrorType (AgentMsgId, PQEncryption)]
+sendMessages c = withAgentEnv c . sendMessages' c
 {-# INLINE sendMessages #-}
 
-sendMessagesB :: Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> IO (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
-sendMessagesB c = withAgentEnv' c . sendMessagesB' c
+sendMessagesB :: Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> AE (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
+sendMessagesB c = withAgentEnv c . sendMessagesB' c
 {-# INLINE sendMessagesB #-}
 
 ackMessage :: AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AE ()
 ackMessage c = withAgentEnv c .:. ackMessage' c
 {-# INLINE ackMessage #-}
 
+getConnectionQueueInfo :: AgentClient -> ConnId -> AE QueueInfo
+getConnectionQueueInfo c = withAgentEnv c . getConnectionQueueInfo' c
+{-# INLINE getConnectionQueueInfo #-}
+
 -- | Switch connection to the new receive queue
 switchConnection :: AgentClient -> ConnId -> AE ConnectionStats
 switchConnection c = withAgentEnv c . switchConnection' c
@@ -425,11 +432,6 @@ setNetworkConfig c@AgentClient {useNetworkConfig} cfg' = do
       else True <$ (writeTVar useNetworkConfig $! (slowNetworkConfig cfg', cfg'))
   when changed $ reconnectAllServers c
 
--- returns fast network config
-getNetworkConfig :: AgentClient -> IO NetworkConfig
-getNetworkConfig = getNetworkConfig'
-{-# INLINE getNetworkConfig #-}
-
 setUserNetworkInfo :: AgentClient -> UserNetworkInfo -> IO ()
 setUserNetworkInfo c@AgentClient {userNetworkInfo, userNetworkUpdated} ni = withAgentEnv' c $ do
   ts' <- liftIO getCurrentTime
@@ -569,7 +571,7 @@ withAgentEnv c a = ExceptT $ runExceptT a `runReaderT` agentEnv c
 logConnection :: AgentClient -> Bool -> IO ()
 logConnection c connected =
   let event = if connected then "connected to" else "disconnected from"
-   in logInfo $ T.unwords ["client", showText (clientId c), event, "Agent"]
+   in logInfo $ T.unwords ["client", tshow (clientId c), event, "Agent"]
 
 -- | Runs an SMP agent instance that receives commands and sends responses via 'TBQueue's.
 runAgentClient :: AgentClient -> AM' ()
@@ -649,14 +651,14 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup
         pure connId
       Nothing -> throwError $ AGENT A_VERSION
 joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption =
-  throwError $ CMD PROHIBITED
+  throwE $ CMD PROHIBITED "joinConnAsync"
 
 allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
 allowConnectionAsync' c corrId connId confId ownConnInfo =
   withStore c (`getConn` connId) >>= \case
     SomeConn _ (RcvConnection _ RcvQueue {server}) ->
       enqueueCommand c corrId connId (Just server) $ AClientCommand $ APC SAEConn $ LET confId ownConnInfo
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "allowConnectionAsync"
 
 acceptContactAsync' :: AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
 acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqSupport subMode = do
@@ -667,7 +669,7 @@ acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqSupport subMode = do
       joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
         withStore' c (`unacceptInvitation` invId)
         throwError err
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "acceptContactAsync"
 
 ackMessageAsync' :: AgentClient -> ACorrId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
 ackMessageAsync' c corrId connId msgId rcptInfo_ = do
@@ -676,14 +678,14 @@ ackMessageAsync' c corrId connId msgId rcptInfo_ = do
     SCDuplex -> enqueueAck
     SCRcv -> enqueueAck
     SCSnd -> throwError $ CONN SIMPLEX
-    SCContact -> throwError $ CMD PROHIBITED
-    SCNew -> throwError $ CMD PROHIBITED
+    SCContact -> throwE $ CMD PROHIBITED "ackMessageAsync: SCContact"
+    SCNew -> throwE $ CMD PROHIBITED "ackMessageAsync: SCNew"
   where
     enqueueAck :: AM ()
     enqueueAck = do
       let mId = InternalId msgId
       RcvMsg {msgType} <- withStore c $ \db -> getRcvMsg db connId mId
-      when (isJust rcptInfo_ && msgType /= AM_A_MSG_) $ throwError $ CMD PROHIBITED
+      when (isJust rcptInfo_ && msgType /= AM_A_MSG_) $ throwE $ CMD PROHIBITED "ackMessageAsync: receipt not allowed"
       (RcvQueue {server}, _) <- withStore c $ \db -> setMsgUserAck db connId mId
       enqueueCommand c corrId connId (Just server) . AClientCommand $ APC SAEConn $ ACK msgId rcptInfo_
 
@@ -711,14 +713,14 @@ switchConnectionAsync' c corrId connId =
   withConnLock c connId "switchConnectionAsync" $
     withStore c (`getConn` connId) >>= \case
       SomeConn _ (DuplexConnection cData rqs@(rq :| _rqs) sqs)
-        | isJust (switchingRQ rqs) -> throwError $ CMD PROHIBITED
+        | isJust (switchingRQ rqs) -> throwE $ CMD PROHIBITED "switchConnectionAsync: already switching"
         | otherwise -> do
-            when (ratchetSyncSendProhibited cData) $ throwError $ CMD PROHIBITED
+            when (ratchetSyncSendProhibited cData) $ throwE $ CMD PROHIBITED "switchConnectionAsync: send prohibited"
             rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
             enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn SWCH
             let rqs' = updatedQs rq1 rqs
             pure . connectionStats $ DuplexConnection cData rqs' sqs
-      _ -> throwError $ CMD PROHIBITED
+      _ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex"
 
 newConn :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, ConnectionRequestUri c)
 newConn c userId connId enableNtfs cMode clientData pqInitKeys subMode =
@@ -735,7 +737,7 @@ newConnSrv c userId connId hasNewConn enableNtfs cMode clientData pqInitKeys sub
 newRcvConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c)
 newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv = do
   case (cMode, pqInitKeys) of
-    (SCMContact, CR.IKUsePQ) -> throwError $ CMD PROHIBITED
+    (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv"
     _ -> pure ()
   AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config
   (rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv smpClientVRange subMode `catchAgentError` \e -> liftIO (print e) >> throwError e
@@ -861,7 +863,7 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
     ExceptT $ updateNewConnSnd db connId q
   confirmQueueAsync c cData q' srv cInfo (Just e2eSndParams) subMode
 joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do
-  throwError $ CMD PROHIBITED
+  throwE $ CMD PROHIBITED "joinConnSrvAsync"
 
 createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
 createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
@@ -886,7 +888,7 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne
         liftIO $ setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
         pure senderKey
       enqueueCommand c "" connId (Just server) . AInternalCommand $ ICAllowSecure rcvId senderKey
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "allowConnection"
 
 -- | Accept contact (ACPT command) in Reader monad
 acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
@@ -898,7 +900,7 @@ acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withCon
       joinConn c userId connId False enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do
         withStore' c (`unacceptInvitation` invId)
         throwError err
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "acceptContact"
 
 -- | Reject contact (RJCT command) in Reader monad
 rejectContact' :: AgentClient -> ConnId -> InvitationId -> AM ()
@@ -998,14 +1000,14 @@ resubscribeConnections' c connIds = do
 
 getConnectionMessage' :: AgentClient -> ConnId -> AM (Maybe SMPMsgMeta)
 getConnectionMessage' c connId = do
-  whenM (atomically $ hasActiveSubscription c connId) . throwError $ CMD PROHIBITED
+  whenM (atomically $ hasActiveSubscription c connId) . throwE $ CMD PROHIBITED "getConnectionMessage: subscribed"
   SomeConn _ conn <- withStore c (`getConn` connId)
   case conn of
     DuplexConnection _ (rq :| _) _ -> getQueueMessage c rq
     RcvConnection _ rq -> getQueueMessage c rq
     ContactConnection _ rq -> getQueueMessage c rq
     SndConnection _ _ -> throwError $ CONN SIMPLEX
-    NewConnection _ -> throwError $ CMD PROHIBITED
+    NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionMessage: NewConnection"
 
 getNotificationMessage' :: AgentClient -> C.CbNonce -> ByteString -> AM (NotificationInfo, [SMPMsgMeta])
 getNotificationMessage' c nonce encNtfInfo = do
@@ -1017,7 +1019,7 @@ getNotificationMessage' c nonce encNtfInfo = do
       ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
       maxMsgs <- asks $ ntfMaxMessages . config
       (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta},) <$> getNtfMessages ntfConnId ntfMsgMeta maxMsgs
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "getNotificationMessage"
   where
     getNtfMessages ntfConnId nMeta = getMsg
       where
@@ -1034,16 +1036,27 @@ getNotificationMessage' c nonce encNtfInfo = do
 
 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: AgentClient -> ConnId -> PQEncryption -> MsgFlags -> MsgBody -> AM (AgentMsgId, PQEncryption)
-sendMessage' c connId pqEnc msgFlags msg = ExceptT $ runIdentity <$> sendMessagesB' c (Identity (Right (connId, pqEnc, msgFlags, msg)))
+sendMessage' c connId pqEnc msgFlags msg = ExceptT $ runIdentity <$> sendMessagesB_ c (Identity (Right (connId, pqEnc, msgFlags, msg))) (S.singleton connId)
 {-# INLINE sendMessage' #-}
 
 -- | Send multiple messages to different connections (SEND command) in Reader monad
-sendMessages' :: AgentClient -> [MsgReq] -> AM' [Either AgentErrorType (AgentMsgId, PQEncryption)]
+sendMessages' :: AgentClient -> [MsgReq] -> AM [Either AgentErrorType (AgentMsgId, PQEncryption)]
 sendMessages' c = sendMessagesB' c . map Right
 {-# INLINE sendMessages' #-}
 
-sendMessagesB' :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
-sendMessagesB' c reqs = withConnLocks c connIds "sendMessages" $ do
+sendMessagesB' :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> AM (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
+sendMessagesB' c reqs = do
+  connIds <- liftEither $ foldl' addConnId (Right S.empty) reqs
+  lift $ sendMessagesB_ c reqs connIds
+  where
+    addConnId s@(Right s') (Right (connId, _, _, _))
+      | B.null connId = s
+      | connId `S.notMember` s' = Right $ S.insert connId s'
+      | otherwise = Left $ INTERNAL "sendMessages: duplicate connection ID"
+    addConnId s _ = s
+
+sendMessagesB_ :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType MsgReq) -> Set ConnId -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
+sendMessagesB_ c reqs connIds = withConnLocks c connIds "sendMessages" $ do
   reqs' <- withStoreBatch c (\db -> fmap (bindRight $ \req@(connId, _, _, _) -> bimap storeError (req,) <$> getConn db connId) reqs)
   let (toEnable, reqs'') = mapAccumL prepareConn [] reqs'
   void $ withStoreBatch' c $ \db -> map (\connId -> setConnPQSupport db connId PQSupportOn) toEnable
@@ -1058,14 +1071,13 @@ sendMessagesB' c reqs = withConnLocks c connIds "sendMessages" $ do
       where
         prepareMsg :: ConnData -> NonEmpty SndQueue -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage))
         prepareMsg cData@ConnData {connId, pqSupport} sqs
-          | ratchetSyncSendProhibited cData = (acc, Left $ CMD PROHIBITED)
+          | ratchetSyncSendProhibited cData = (acc, Left $ CMD PROHIBITED "sendMessagesB: send prohibited")
           -- connection is only updated if PQ encryption was disabled, and now it has to be enabled.
           -- support for PQ encryption (small message envelopes) will not be disabled when message is sent.
           | pqEnc == PQEncOn && pqSupport == PQSupportOff =
               let cData' = cData {pqSupport = PQSupportOn} :: ConnData
                in (connId : acc, Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg))
           | otherwise = (acc, Right (cData, sqs, Just pqEnc, msgFlags, A_MSG msg))
-    connIds = map (\(connId, _, _, _) -> connId) $ rights $ toList reqs
 
 -- / async command processing v v v
 
@@ -1121,7 +1133,7 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
             withStore c (`getConn` connId) >>= \case
               SomeConn _ conn@(DuplexConnection _ (replaced :| _rqs) _) ->
                 switchDuplexConnection c conn replaced >>= notify . SWITCH QDRcv SPStarted
-              _ -> throwError $ CMD PROHIBITED
+              _ -> throwE $ CMD PROHIBITED "SWCH: not duplex"
         DEL -> withServer' . tryCommand $ deleteConnection' c connId >> notify OK
         _ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd)
       AInternalCommand cmd -> case cmd of
@@ -1331,7 +1343,11 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork
                   AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
                   _ -> do
                     expireTs <- addUTCTime (-quotaExceededTimeout) <$> liftIO getCurrentTime
-                    if internalTs < expireTs then notifyDelMsgs msgId e expireTs else retrySndMsg RISlow
+                    if internalTs < expireTs
+                      then notifyDelMsgs msgId e expireTs
+                      else do
+                        notify $ MWARN (unId msgId) e
+                        retrySndMsg RISlow
                 SMP _ SMP.AUTH -> case msgType of
                   AM_CONN_INFO -> connError msgId NOT_AVAILABLE
                   AM_CONN_INFO_REPLY -> connError msgId NOT_AVAILABLE
@@ -1467,8 +1483,8 @@ ackMessage' c connId msgId rcptInfo_ = withConnLock c connId "ackMessage" $ do
     DuplexConnection {} -> ack >> sendRcpt conn >> del
     RcvConnection {} -> ack >> del
     SndConnection {} -> throwError $ CONN SIMPLEX
-    ContactConnection {} -> throwError $ CMD PROHIBITED
-    NewConnection _ -> throwError $ CMD PROHIBITED
+    ContactConnection {} -> throwE $ CMD PROHIBITED "ackMessage: ContactConnection"
+    NewConnection _ -> throwE $ CMD PROHIBITED "ackMessage: NewConnection"
   where
     ack :: AM ()
     ack = do
@@ -1482,7 +1498,7 @@ ackMessage' c connId msgId rcptInfo_ = withConnLock c connId "ackMessage" $ do
       msg@RcvMsg {msgType, msgReceipt} <- withStore c $ \db -> getRcvMsg db connId $ InternalId msgId
       case rcptInfo_ of
         Just rcptInfo -> do
-          unless (msgType == AM_A_MSG_) $ throwError (CMD PROHIBITED)
+          unless (msgType == AM_A_MSG_) . throwE $ CMD PROHIBITED "ackMessage: receipt not allowed"
           when (connAgentVersion >= deliveryRcptsSMPAgentVersion) $ do
             let RcvMsg {msgMeta = MsgMeta {sndMsgId}, internalHash} = msg
                 rcpt = A_RCVD [AMessageReceipt {agentMsgId = sndMsgId, msgHash = internalHash, rcptInfo}]
@@ -1493,17 +1509,27 @@ ackMessage' c connId msgId rcptInfo_ = withConnLock c connId "ackMessage" $ do
             withStore' c $ \db -> deleteDeliveredSndMsg db connId $ InternalId sndMsgId
           _ -> pure ()
 
+getConnectionQueueInfo' :: AgentClient -> ConnId -> AM QueueInfo
+getConnectionQueueInfo' c connId = do
+  SomeConn _ conn <- withStore c (`getConn` connId)
+  case conn of
+    DuplexConnection _ (rq :| _) _ -> getQueueInfo c rq
+    RcvConnection _ rq -> getQueueInfo c rq
+    ContactConnection _ rq -> getQueueInfo c rq
+    SndConnection {} -> throwE $ CONN SIMPLEX
+    NewConnection _ -> throwE $ CMD PROHIBITED "getConnectionQueueInfo': NewConnection"
+
 switchConnection' :: AgentClient -> ConnId -> AM ConnectionStats
 switchConnection' c connId =
   withConnLock c connId "switchConnection" $
     withStore c (`getConn` connId) >>= \case
       SomeConn _ conn@(DuplexConnection cData rqs@(rq :| _rqs) _)
-        | isJust (switchingRQ rqs) -> throwError $ CMD PROHIBITED
+        | isJust (switchingRQ rqs) -> throwE $ CMD PROHIBITED "switchConnection: already switching"
         | otherwise -> do
-            when (ratchetSyncSendProhibited cData) $ throwError $ CMD PROHIBITED
+            when (ratchetSyncSendProhibited cData) $ throwE $ CMD PROHIBITED "switchConnection: send prohibited"
             rq' <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
             switchDuplexConnection c conn rq'
-      _ -> throwError $ CMD PROHIBITED
+      _ -> throwE $ CMD PROHIBITED "switchConnection: not duplex"
 
 switchDuplexConnection :: AgentClient -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
 switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBQueueId dbQueueId, sndId} = do
@@ -1528,7 +1554,7 @@ abortConnectionSwitch' c connId =
       SomeConn _ (DuplexConnection cData rqs sqs) -> case switchingRQ rqs of
         Just rq
           | canAbortRcvSwitch rq -> do
-              when (ratchetSyncSendProhibited cData) $ throwError $ CMD PROHIBITED
+              when (ratchetSyncSendProhibited cData) $ throwE $ CMD PROHIBITED "abortConnectionSwitch: send prohibited"
               -- multiple queues to which the connections switches were possible when repeating switch was allowed
               let (delRqs, keepRqs) = L.partition ((Just (dbQId rq) ==) . dbReplaceQId) rqs
               case L.nonEmpty keepRqs of
@@ -1541,9 +1567,9 @@ abortConnectionSwitch' c connId =
                       conn' = DuplexConnection cData rqs'' sqs
                   pure $ connectionStats conn'
                 _ -> throwError $ INTERNAL "won't delete all rcv queues in connection"
-          | otherwise -> throwError $ CMD PROHIBITED
-        _ -> throwError $ CMD PROHIBITED
-      _ -> throwError $ CMD PROHIBITED
+          | otherwise -> throwE $ CMD PROHIBITED "abortConnectionSwitch: no rcv queues left"
+        _ -> throwE $ CMD PROHIBITED "abortConnectionSwitch: not allowed"
+      _ -> throwE $ CMD PROHIBITED "abortConnectionSwitch: not duplex"
 
 synchronizeRatchet' :: AgentClient -> ConnId -> PQSupport -> Bool -> AM ConnectionStats
 synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchronizeRatchet" $ do
@@ -1563,8 +1589,8 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
           let cData'' = cData' {ratchetSyncState = RSStarted} :: ConnData
               conn' = DuplexConnection cData'' rqs sqs
           pure $ connectionStats conn'
-      | otherwise -> throwError $ CMD PROHIBITED
-    _ -> throwError $ CMD PROHIBITED
+      | otherwise -> throwE $ CMD PROHIBITED "synchronizeRatchet: not allowed"
+    _ -> throwE $ CMD PROHIBITED "synchronizeRatchet: not duplex"
 
 ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM ()
 ackQueueMessage c rq srvMsgId =
@@ -1581,7 +1607,7 @@ suspendConnection' c connId = withConnLock c connId "suspendConnection" $ do
     RcvConnection _ rq -> suspendQueue c rq
     ContactConnection _ rq -> suspendQueue c rq
     SndConnection _ _ -> throwError $ CONN SIMPLEX
-    NewConnection _ -> throwError $ CMD PROHIBITED
+    NewConnection _ -> throwE $ CMD PROHIBITED "suspendConnection"
 
 -- | Delete SMP agent connection (DEL command) in Reader monad
 -- unlike deleteConnectionAsync, this function does not mark connection as deleted in case of deletion failure
@@ -1819,7 +1845,7 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
               withStore' c (`createNtfToken` tkn)
               registerToken tkn
               pure NTRegistered
-        _ -> throwError $ CMD PROHIBITED
+        _ -> throwE $ CMD PROHIBITED "createToken"
     registerToken :: NtfToken -> AM ()
     registerToken tkn@NtfToken {ntfPubKey, ntfDhKeys = (pubDhKey, privDhKey)} = do
       (tknId, srvPubDhKey) <- agentNtfRegisterToken c tkn ntfPubKey pubDhKey
@@ -1832,7 +1858,7 @@ verifyNtfToken' :: AgentClient -> DeviceToken -> C.CbNonce -> ByteString -> AM (
 verifyNtfToken' c deviceToken nonce code =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId = Just tknId, ntfDhSecret = Just dhSecret, ntfMode} -> do
-      when (deviceToken /= savedDeviceToken) . throwError $ CMD PROHIBITED
+      when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "verifyNtfToken: different token"
       code' <- liftEither . bimap cryptoError NtfRegCode $ C.cbDecrypt dhSecret nonce code
       toStatus <-
         withToken c tkn (Just (NTConfirmed, NTAVerify code')) (NTActive, Just NTACheck) $
@@ -1841,36 +1867,36 @@ verifyNtfToken' c deviceToken nonce code =
         cron <- asks $ ntfCron . config
         agentNtfEnableCron c tknId tkn cron
         when (ntfMode == NMInstant) $ initializeNtfSubs c
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "verifyNtfToken: no token"
 
 checkNtfToken' :: AgentClient -> DeviceToken -> AM NtfTknStatus
 checkNtfToken' c deviceToken =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId = Just tknId} -> do
-      when (deviceToken /= savedDeviceToken) . throwError $ CMD PROHIBITED
+      when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "checkNtfToken: different token"
       agentNtfCheckToken c tknId tkn
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "checkNtfToken: no token"
 
 deleteNtfToken' :: AgentClient -> DeviceToken -> AM ()
 deleteNtfToken' c deviceToken =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken} -> do
-      when (deviceToken /= savedDeviceToken) . throwError $ CMD PROHIBITED
+      when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "deleteNtfToken: different token"
       deleteToken_ c tkn
       deleteNtfSubs c NSCSmpDelete
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
 
 getNtfToken' :: AgentClient -> AM (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken' c =
   withStore' c getSavedNtfToken >>= \case
     Just NtfToken {deviceToken, ntfTknStatus, ntfMode, ntfServer} -> pure (deviceToken, ntfTknStatus, ntfMode, ntfServer)
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "getNtfToken"
 
 getNtfTokenData' :: AgentClient -> AM NtfToken
 getNtfTokenData' c =
   withStore' c getSavedNtfToken >>= \case
     Just tkn -> pure tkn
-    _ -> throwError $ CMD PROHIBITED
+    _ -> throwE $ CMD PROHIBITED "getNtfTokenData"
 
 -- | Set connection notifications, in Reader monad
 toggleConnectionNtfs' :: AgentClient -> ConnId -> Bool -> AM ()
@@ -2089,7 +2115,6 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
         Left e -> lift $ notifyErr connId e
     STResponse (Cmd SRecipient cmd) respOrErr ->
       withRcvConn entId $ \rq conn -> case cmd of
-        -- TODO process expired responses to ACK and DEL
         SMP.SUB -> case respOrErr of
           Right SMP.OK -> processSubOk rq upConnIds
           Right msg@SMP.MSG {} -> do
@@ -2097,7 +2122,10 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
             processSMP rq conn (toConnData conn) msg
           Right r -> processSubErr rq $ unexpectedResponse r
           Left e -> unless (temporaryClientError e) $ processSubErr rq e -- timeout/network was already reported
-        _ -> pure ()
+        SMP.ACK _ -> case respOrErr of
+          Right msg@SMP.MSG {} -> processSMP rq conn (toConnData conn) msg
+          _ -> pure () -- TODO process OK response to ACK
+        _ -> pure () -- TODO process expired response to DEL
     STResponse {} -> pure () -- TODO process expired responses to sent messages
     STUnexpectedError e -> do
       logServer "<--" c srv entId $ "error: " <> bshow e
@@ -2160,7 +2188,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                         smpConfirmation srvMsgId conn senderKey e2ePubKey e2eEncryption_ encConnInfo phVer agentVersion >> ack
                       (SMP.PHEmpty, AgentInvitation {connReq, connInfo}) ->
                         smpInvitation srvMsgId conn connReq connInfo >> ack
-                      _ -> prohibited >> ack
+                      _ -> prohibited "handshake: incorrect state" >> ack
                   (Just e2eDh, Nothing) -> do
                     decryptClientMessage e2eDh clientMsg >>= \case
                       (SMP.PHEmpty, AgentRatchetKey {agentVersion, e2eEncryption}) -> do
@@ -2184,7 +2212,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                         let encryptedMsgHash = C.sha256Hash encAgentMessage
                         g <- asks random
                         atomically updateTotalMsgCount
-                        tryError (agentClientMsg g encryptedMsgHash) >>= \case
+                        tryAgentError (agentClientMsg g encryptedMsgHash) >>= \case
                           Right (Just (msgId, msgMeta, aMessage, rcPrev)) -> do
                             conn'' <- resetRatchetSync
                             case aMessage of
@@ -2215,13 +2243,13 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                                     withStore' c $ \db -> setConnRatchetSync db connId RSOk
                                     pure conn''
                                 | otherwise = pure conn'
-                          Right _ -> prohibited >> ack
+                          Right Nothing -> prohibited "msg: bad agent msg" >> ack
                           Left e@(AGENT A_DUPLICATE) -> do
                             atomically updateDupMsgCount
                             withStore' c (\db -> getLastMsg db connId srvMsgId) >>= \case
                               Just RcvMsg {internalId, msgMeta, msgBody = agentMsgBody, userAck}
                                 | userAck -> ackDel internalId
-                                | otherwise -> do
+                                | otherwise ->
                                     liftEither (parse smpP (AGENT A_MESSAGE) agentMsgBody) >>= \case
                                       AgentMessage _ (A_MSG body) -> do
                                         logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret srvMsgId
@@ -2280,8 +2308,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                                 liftIO $ createRcvMsg db connId rq rcvMsg
                                 pure $ Just (internalId, msgMeta, aMessage, rc)
                               _ -> pure Nothing
-                      _ -> prohibited >> ack
-                  _ -> prohibited >> ack
+                      _ -> prohibited "msg: bad client msg" >> ack
+                  _ -> prohibited "msg: no keys" >> ack
               updateConnVersion :: Connection c -> ConnData -> VersionSMPA -> AM (Connection c)
               updateConnVersion conn' cData' msgAgentVersion = do
                 aVRange <- asks $ smpAgentVRange . config
@@ -2318,8 +2346,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
           notify :: forall e m. (AEntityI e, MonadIO m) => ACommand 'Agent e -> m ()
           notify = notify' connId
 
-          prohibited :: AM ()
-          prohibited = notify . ERR $ AGENT A_PROHIBITED
+          prohibited :: String -> AM ()
+          prohibited = notify . ERR . AGENT . A_PROHIBITED
 
           enqueueCmd :: InternalCommand -> AM ()
           enqueueCmd = enqueueCommand c "" connId (Just srv) . AInternalCommand
@@ -2371,7 +2399,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                       parseMessage agentMsgBody >>= \case
                         AgentConnInfoReply smpQueues connInfo ->
                           processConf connInfo SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues = L.toList smpQueues, smpClientVersion}
-                        _ -> prohibited -- including AgentConnInfo, that is prohibited here in v2
+                        _ -> prohibited "conf: not AgentConnInfoReply" -- including AgentConnInfo, that is prohibited here in v2
                       where
                         processConf connInfo senderConf = do
                           let newConfirmation = NewConfirmation {connId, senderConf, ratchetState = rc'}
@@ -2381,7 +2409,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                             createConfirmation db g newConfirmation
                           let srvs = map qServer $ smpReplyQueues senderConf
                           notify $ CONF confId pqSupport' srvs connInfo
-                    _ -> prohibited
+                    _ -> prohibited "conf: decrypt error or skipped"
                 -- party accepting connection
                 (DuplexConnection _ (RcvQueue {smpClientVersion = v'} :| _) _, Nothing) -> do
                   g <- asks random
@@ -2391,15 +2419,15 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                       let dhSecret = C.dh' e2ePubKey e2ePrivKey
                       withStore' c $ \db -> setRcvQueueConfirmedE2E db rq dhSecret $ min v' smpClientVersion
                       enqueueCmd $ ICDuplexSecure rId senderKey
-                    _ -> prohibited
-                _ -> prohibited
-              _ -> prohibited
+                    _ -> prohibited "conf: not AgentConnInfo"
+                _ -> prohibited "conf: incorrect state"
+              _ -> prohibited "conf: status /= new"
 
           helloMsg :: SMP.MsgId -> MsgMeta -> Connection c -> AM ()
           helloMsg srvMsgId MsgMeta {pqEncryption} conn' = do
             logServer "<--" c srv rId $ "MSG <HELLO>:" <> logSecret srvMsgId
             case status of
-              Active -> prohibited
+              Active -> prohibited "hello: active"
               _ ->
                 case conn' of
                   DuplexConnection _ _ (sq@SndQueue {status = sndStatus} :| _)
@@ -2441,7 +2469,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                 let sndMsgId = InternalSndId agentMsgId
                 SndMsg {internalId = InternalId msgId, msgType, internalHash, msgReceipt} <- withStore c $ \db -> getSndMsgViaRcpt db connId sndMsgId
                 if msgType /= AM_A_MSG_
-                  then notify (ERR $ AGENT A_PROHIBITED) $> Nothing -- unexpected message type for receipt
+                  then prohibited "receipt: not a msg" $> Nothing
                   else case msgReceipt of
                     Just MsgReceipt {msgRcptStatus = MROk} -> pure Nothing -- already notified with MROk status
                     _ -> do
@@ -2549,7 +2577,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(_, srv, _), _v, sessId, ts)
                 invId <- withStore c $ \db -> createInvitation db g newInv
                 let srvs = L.map qServer $ crSmpQueues crData
                 notify $ REQ invId pqSupport srvs cInfo
-              _ -> prohibited
+              _ -> prohibited "inv: sent to message conn"
             where
               pqSupported (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible agentVersion) =
                 PQSupportOn `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just v)

src/Simplex/Messaging/Agent/Client.hs

@@ -56,6 +56,7 @@ module Simplex.Messaging.Agent.Client
     disableQueueNotifications,
     disableQueuesNtfs,
     sendAgentMessage,
+    getQueueInfo,
     agentNtfRegisterToken,
     agentNtfVerifyToken,
     agentNtfCheckToken,
@@ -137,6 +138,8 @@ module Simplex.Messaging.Agent.Client
     getAgentWorkersDetails,
     AgentWorkersSummary (..),
     getAgentWorkersSummary,
+    AgentQueuesInfo (..),
+    getAgentQueuesInfo,
     SMPTransportSession,
     NtfTransportSession,
     XFTPTransportSession,
@@ -175,7 +178,7 @@ import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Text.Encoding
-import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
+import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Word (Word16)
 import qualified Database.SQLite.Simple as SQL
@@ -185,6 +188,7 @@ import qualified Simplex.FileTransfer.Client as X
 import Simplex.FileTransfer.Description (ChunkReplicaId (..), FileDigest (..), kb)
 import Simplex.FileTransfer.Protocol (FileInfo (..), FileResponse)
 import Simplex.FileTransfer.Transport (XFTPErrorType (DIGEST), XFTPRcvChunkSpec (..), XFTPVersion)
+import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types (DeletedSndChunkReplica (..), NewSndChunkReplica (..), RcvFileChunkReplica (..), SndFileChunk (..), SndFileChunkReplica (..))
 import Simplex.FileTransfer.Util (uniqueCombine)
 import Simplex.Messaging.Agent.Env.SQLite
@@ -197,7 +201,6 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Agent.TRcvQueues (TRcvQueues (getRcvQueues))
 import qualified Simplex.Messaging.Agent.TRcvQueues as RQ
 import Simplex.Messaging.Client
-import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -205,7 +208,7 @@ import Simplex.Messaging.Notifications.Client
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Transport (NTFVersion)
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parse)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parse, sumTypeJSON)
 import Simplex.Messaging.Protocol
   ( AProtocolType (..),
     BrokerMsg,
@@ -237,6 +240,7 @@ import Simplex.Messaging.Protocol
     sameSrvAddr',
   )
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -252,7 +256,7 @@ import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, removeFile)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
-type ClientVar msg = SessionVar (Either AgentErrorType (Client msg))
+type ClientVar msg = SessionVar (Either (AgentErrorType, Maybe UTCTime) (Client msg))
 
 type SMPClientVar = ClientVar SMP.BrokerMsg
 
@@ -583,8 +587,9 @@ instance ProtocolServerClient XFTPVersion XFTPErrorType FileResponse where
 getSMPServerClient :: AgentClient -> SMPTransportSession -> AM SMPConnectedClient
 getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
   unlessM (readTVarIO active) . throwError $ INACTIVE
-  atomically (getSessVar workerSeq tSess smpClients)
-    >>= either newClient (waitForProtocolClient c tSess)
+  ts <- liftIO getCurrentTime
+  atomically (getSessVar workerSeq tSess smpClients ts)
+    >>= either newClient (waitForProtocolClient c tSess smpClients)
   where
     newClient v = do
       prs <- atomically TM.empty
@@ -594,28 +599,30 @@ getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClien
 getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} destSess@(userId, destSrv, qId) = do
   unlessM (readTVarIO active) . throwError $ INACTIVE
   proxySrv <- getNextServer c userId [destSrv]
-  atomically (getClientVar proxySrv) >>= \(tSess, auth, v) ->
-    either (newProxyClient tSess auth) (waitForProxyClient tSess auth) v
+  ts <- liftIO getCurrentTime
+  atomically (getClientVar proxySrv ts) >>= \(tSess, auth, v) ->
+    either (newProxyClient tSess auth ts) (waitForProxyClient tSess auth) v
   where
-    getClientVar :: SMPServerWithAuth -> STM (SMPTransportSession, Maybe SMP.BasicAuth, Either SMPClientVar SMPClientVar)
-    getClientVar proxySrv = do
+    getClientVar :: SMPServerWithAuth -> UTCTime -> STM (SMPTransportSession, Maybe SMP.BasicAuth, Either SMPClientVar SMPClientVar)
+    getClientVar proxySrv ts = do
       ProtoServerWithAuth srv auth <- TM.lookup destSess smpProxiedRelays >>= maybe (TM.insert destSess proxySrv smpProxiedRelays $> proxySrv) pure
       let tSess = (userId, srv, qId)
-      (tSess,auth,) <$> getSessVar workerSeq tSess smpClients
-    newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
-    newProxyClient tSess auth v = do
+      (tSess,auth,) <$> getSessVar workerSeq tSess smpClients ts
+    newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> UTCTime -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
+    newProxyClient tSess auth ts v = do
       (prs, rv) <- atomically $ do
         prs <- TM.empty
         -- we do not need to check if it is a new proxied relay session,
         -- as the client is just created and there are no sessions yet
-        (prs,) . either id id <$> getSessVar workerSeq destSrv prs
+        (prs,) . either id id <$> getSessVar workerSeq destSrv prs ts
       clnt <- smpConnectClient c tSess prs v
       (clnt,) <$> newProxiedRelay clnt auth rv
     waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
     waitForProxyClient tSess auth v = do
-      clnt@(SMPConnectedClient _ prs) <- waitForProtocolClient c tSess v
+      clnt@(SMPConnectedClient _ prs) <- waitForProtocolClient c tSess smpClients v
+      ts <- liftIO getCurrentTime
       sess <-
-        atomically (getSessVar workerSeq destSrv prs)
+        atomically (getSessVar workerSeq destSrv prs ts)
           >>= either (newProxiedRelay clnt auth) (waitForProxiedRelay tSess)
       pure (clnt, sess)
     newProxiedRelay :: SMPConnectedClient -> Maybe SMP.BasicAuth -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay)
@@ -689,25 +696,25 @@ smpClientDisconnected c@AgentClient {active, smpClients, smpProxiedRelays} tSess
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, APC (sAEntity @e) cmd)
 
 resubscribeSMPSession :: AgentClient -> SMPTransportSession -> AM' ()
-resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess =
-  atomically getWorkerVar >>= mapM_ (either newSubWorker (\_ -> pure ()))
+resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess = do
+  ts <- liftIO getCurrentTime
+  atomically (getWorkerVar ts) >>= mapM_ (either newSubWorker (\_ -> pure ()))
   where
-    getWorkerVar =
+    getWorkerVar ts =
       ifM
         (null <$> getPending)
         (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
-        (Just <$> getSessVar workerSeq tSess smpSubWorkers)
+        (Just <$> getSessVar workerSeq tSess smpSubWorkers ts)
     newSubWorker v = do
       a <- async $ void (E.tryAny runSubWorker) >> atomically (cleanup v)
       atomically $ putTMVar (sessionVar v) a
     runSubWorker = do
       ri <- asks $ reconnectInterval . config
-      timeoutCounts <- newTVarIO 0
       withRetryInterval ri $ \_ loop -> do
         pending <- atomically getPending
         forM_ (L.nonEmpty pending) $ \qs -> do
-          lift $ waitForUserNetwork c
-          void . tryAgentError' $ reconnectSMPClient timeoutCounts c tSess qs
+          liftIO $ waitForUserNetwork c
+          reconnectSMPClient c tSess qs
           loop
     getPending = RQ.getSessQueues tSess $ pendingSubs c
     cleanup :: SessionVar (Async ()) -> STM ()
@@ -717,50 +724,36 @@ resubscribeSMPSession c@AgentClient {smpSubWorkers, workerSeq} tSess =
       whenM (isEmptyTMVar $ sessionVar v) retry
       removeSessVar v tSess smpSubWorkers
 
-reconnectSMPClient :: TVar Int -> AgentClient -> SMPTransportSession -> NonEmpty RcvQueue -> AM ()
-reconnectSMPClient tc c tSess@(_, srv, _) qs = do
-  NetworkConfig {tcpTimeout} <- atomically $ getNetworkConfig c
-  -- this allows 3x of timeout per batch of subscription (90 queues per batch empirically)
-  let t = (length qs `div` 90 + 1) * tcpTimeout * 3
-  ExceptT (sequence <$> (t `timeout` runExceptT resubscribe)) >>= \case
-    Just _ -> resetTimeouts
-    -- reset and do not report consecutive timeouts while offline
-    Nothing -> ifM (atomically $ isNetworkOnline c) notifyTimeout resetTimeouts
+reconnectSMPClient :: AgentClient -> SMPTransportSession -> NonEmpty RcvQueue -> AM' ()
+reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
+  cs <- readTVarIO $ RQ.getConnections $ activeSubs c
+  (rs, sessId_) <- subscribeQueues c $ L.toList qs
+  let (errs, okConns) = partitionEithers $ map (\(RcvQueue {connId}, r) -> bimap (connId,) (const connId) r) rs
+      conns = filter (`M.notMember` cs) okConns
+  unless (null conns) $ notifySub "" $ UP srv conns
+  let (tempErrs, finalErrs) = partition (temporaryAgentError . snd) errs
+  mapM_ (\(connId, e) -> notifySub connId $ ERR e) finalErrs
+  forM_ (listToMaybe tempErrs) $ \(connId, e) -> do
+    when (null okConns && M.null cs && null finalErrs) . liftIO $
+      forM_ sessId_ $ \sessId -> do
+        -- We only close the client session that was used to subscribe.
+        v_ <- atomically $ ifM (activeClientSession c tSess sessId) (TM.lookupDelete tSess $ smpClients c) (pure Nothing)
+        mapM_ (closeClient_ c) v_
+    notifySub connId $ ERR e
   where
-    resetTimeouts = atomically $ writeTVar tc 0
-    notifyTimeout = do
-      tc' <- atomically $ stateTVar tc $ \i -> (i + 1, i + 1)
-      maxTC <- asks $ maxSubscriptionTimeouts . config
-      when (tc' >= maxTC) $ do
-        let msg = show tc' <> " consecutive subscription timeouts: " <> show (length qs) <> " queues, transport session: " <> show tSess
-        atomically $ writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ INTERNAL msg)
-    resubscribe :: AM ()
-    resubscribe = do
-      cs <- readTVarIO $ RQ.getConnections $ activeSubs c
-      (rs, sessId_) <- lift . subscribeQueues c $ L.toList qs
-      let (errs, okConns) = partitionEithers $ map (\(RcvQueue {connId}, r) -> bimap (connId,) (const connId) r) rs
-      liftIO $ do
-        let conns = filter (`M.notMember` cs) okConns
-        unless (null conns) $ notifySub "" $ UP srv conns
-      let (tempErrs, finalErrs) = partition (temporaryAgentError . snd) errs
-      liftIO $ mapM_ (\(connId, e) -> notifySub connId $ ERR e) finalErrs
-      forM_ (listToMaybe tempErrs) $ \(_, err) -> do
-        when (null okConns && M.null cs && null finalErrs) . liftIO $
-          forM_ sessId_ $ \sessId -> do
-            -- We only close the client session that was used to subscribe.
-            v_ <- atomically $ ifM (activeClientSession c tSess sessId) (TM.lookupDelete tSess $ smpClients c) (pure Nothing)
-            mapM_ (closeClient_ c) v_
-        throwError err
-    notifySub :: forall e. AEntityI e => ConnId -> ACommand 'Agent e -> IO ()
+    handleNotify :: AM' () -> AM' ()
+    handleNotify = E.handleAny $ notifySub "" . ERR . INTERNAL . show
+    notifySub :: forall e. AEntityI e => ConnId -> ACommand 'Agent e -> AM' ()
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, APC (sAEntity @e) cmd)
 
 getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
 getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId, srv, _) = do
   unlessM (readTVarIO active) . throwError $ INACTIVE
-  atomically (getSessVar workerSeq tSess ntfClients)
+  ts <- liftIO getCurrentTime
+  atomically (getSessVar workerSeq tSess ntfClients ts)
     >>= either
       (newProtocolClient c tSess ntfClients connectClient)
-      (waitForProtocolClient c tSess)
+      (waitForProtocolClient c tSess ntfClients)
   where
     connectClient :: NtfClientVar -> AM NtfClient
     connectClient v = do
@@ -780,10 +773,11 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(userId,
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
 getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId, srv, _) = do
   unlessM (readTVarIO active) . throwError $ INACTIVE
-  atomically (getSessVar workerSeq tSess xftpClients)
+  ts <- liftIO getCurrentTime
+  atomically (getSessVar workerSeq tSess xftpClients ts)
     >>= either
       (newProtocolClient c tSess xftpClients connectClient)
-      (waitForProtocolClient c tSess)
+      (waitForProtocolClient c tSess xftpClients)
   where
     connectClient :: XFTPClientVar -> AM XFTPClient
     connectClient v = do
@@ -800,14 +794,26 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(userId
       atomically $ writeTBQueue (subQ c) ("", "", APC SAENone $ hostEvent DISCONNECT client)
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
-waitForProtocolClient :: ProtocolTypeI (ProtoType msg) => AgentClient -> TransportSession msg -> ClientVar msg -> AM (Client msg)
-waitForProtocolClient c (_, srv, _) v = do
+waitForProtocolClient ::
+  (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) =>
+  AgentClient ->
+  TransportSession msg ->
+  TMap (TransportSession msg) (ClientVar msg) ->
+  ClientVar msg ->
+  AM (Client msg)
+waitForProtocolClient c tSess@(_, srv, _) clients v = do
   NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c
   client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
-  liftEither $ case client_ of
-    Just (Right smpClient) -> Right smpClient
-    Just (Left e) -> Left e
-    Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT
+  case client_ of
+    Just (Right smpClient) -> pure smpClient
+    Just (Left (e, ts_)) -> case ts_ of
+      Nothing -> throwE e
+      Just ts ->
+        ifM
+          ((ts <) <$> liftIO getCurrentTime)
+          (atomically (removeSessVar v tSess clients) >> getProtocolServerClient c tSess)
+          (throwE e)
+    Nothing -> throwE $ BROKER (B.unpack $ strEncode srv) TIMEOUT
 
 -- clientConnected arg is only passed for SMP server
 newProtocolClient ::
@@ -829,10 +835,15 @@ newProtocolClient c tSess@(userId, srv, entityId_) clients connectClient v =
       pure client
     Left e -> do
       liftIO $ incServerStat c userId srv "CLIENT" $ strEncode e
-      atomically $ do
-        removeSessVar v tSess clients
-        putTMVar (sessionVar v) (Left e)
-      throwError e -- signal error to caller
+      ei <- asks $ persistErrorInterval . config
+      if ei == 0
+        then atomically $ do
+          removeSessVar v tSess clients
+          putTMVar (sessionVar v) (Left (e, Nothing))
+        else do
+          ts <- addUTCTime ei <$> liftIO getCurrentTime
+          atomically $ putTMVar (sessionVar v) (Left (e, Just ts))
+      throwE e -- signal error to caller
 
 hostEvent :: forall v err msg. (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) => (AProtocolType -> TransportHost -> ACommand 'Agent 'AENone) -> Client msg -> ACommand 'Agent 'AENone
 hostEvent event = hostEvent' event . protocolClient
@@ -950,15 +961,15 @@ withInvLock' :: AgentClient -> ByteString -> String -> AM' a -> AM' a
 withInvLock' AgentClient {invLocks} = withLockMap invLocks
 {-# INLINE withInvLock' #-}
 
-withConnLocks :: AgentClient -> [ConnId] -> String -> AM' a -> AM' a
-withConnLocks AgentClient {connLocks} = withLocksMap_ connLocks . filter (not . B.null)
+withConnLocks :: AgentClient -> Set ConnId -> String -> AM' a -> AM' a
+withConnLocks AgentClient {connLocks} = withLocksMap_ connLocks
 {-# INLINE withConnLocks #-}
 
 withLockMap :: (Ord k, MonadUnliftIO m) => TMap k Lock -> k -> String -> m a -> m a
 withLockMap = withGetLock . getMapLock
 {-# INLINE withLockMap #-}
 
-withLocksMap_ :: (Ord k, MonadUnliftIO m) => TMap k Lock -> [k] -> String -> m a -> m a
+withLocksMap_ :: (Ord k, MonadUnliftIO m) => TMap k Lock -> Set k -> String -> m a -> m a
 withLocksMap_ = withGetLocks . getMapLock
 {-# INLINE withLocksMap_ #-}
 
@@ -1039,17 +1050,35 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do
         SPFAllowProtected -> ipAddressProtected cfg destSrv
         SPFProhibit -> False
     unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c)
-    sendViaProxy destSess = do
+    sendViaProxy destSess@(_, _, qId) = do
       r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do
         liftClient SMP (clientServer smp) (proxySMPMessage smp proxySess spKey_ senderId msgFlags msg) >>= \case
           Right () -> pure . Just $ protocolClientServer' smp
-          Left proxyErr ->
+          Left proxyErr -> do
+            case proxyErr of
+              (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION)) -> atomically deleteRelaySession
+              _ -> pure ()
             throwE
               PROXY
                 { proxyServer = protocolClientServer smp,
                   relayServer = B.unpack $ strEncode destSrv,
                   proxyErr
                 }
+            where
+              -- checks that the current proxied relay session is the same one that was used to send the message and removes it
+              deleteRelaySession =
+                ( TM.lookup destSess (smpProxiedRelays c)
+                    $>>= \(ProtoServerWithAuth srv _) -> tryReadSessVar (userId, srv, qId) (smpClients c)
+                )
+                  >>= \case
+                    Just (Right (SMPConnectedClient smp' prs))
+                      | sameClient smp' ->
+                          tryReadSessVar destSrv prs >>= \case
+                            Just (Right proxySess') | sameProxiedRelay proxySess' -> TM.delete destSrv prs
+                            _ -> pure ()
+                    _ -> pure ()
+              sameClient smp' = sessionId (thParams smp) == sessionId (thParams smp')
+              sameProxiedRelay proxySess' = prSessionId proxySess == prSessionId proxySess'
       case r of
         Right r' -> pure r'
         Left e
@@ -1287,7 +1316,9 @@ temporaryAgentError :: AgentErrorType -> Bool
 temporaryAgentError = \case
   BROKER _ e -> tempBrokerError e
   SMP _ (SMP.PROXY (SMP.BROKER e)) -> tempBrokerError e
+  XFTP _ XFTP.TIMEOUT -> True
   PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> tempBrokerError e
+  PROXY _ _ (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION)) -> True
   INACTIVE -> True
   _ -> False
   where
@@ -1327,7 +1358,7 @@ subscribeQueues c qs = do
   where
     checkQueue rq = do
       prohibited <- atomically $ hasGetLock c rq
-      pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED) else Right rq
+      pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED "subscribeQueues") else Right rq
     subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
     subscribeQueues_ env session smp qs' = do
       rs <- sendBatch subscribeSMPQueues smp qs'
@@ -1550,6 +1581,11 @@ sendAgentMessage c sq@SndQueue {userId, server, sndId, sndPrivateKey} msgFlags a
   msg <- agentCbEncrypt sq Nothing $ smpEncode clientMsg
   sendOrProxySMPMessage c userId server "<MSG>" (Just sndPrivateKey) sndId msgFlags msg
 
+getQueueInfo :: AgentClient -> RcvQueue -> AM QueueInfo
+getQueueInfo c rq@RcvQueue {rcvId, rcvPrivateKey} =
+  withSMPClient c rq "QUE" $ \smp ->
+    getSMPQueueInfo smp rcvPrivateKey rcvId
+
 agentNtfRegisterToken :: AgentClient -> NtfToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =
   withClient c (0, ntfServer, Nothing) "TNEW" $ \ntf -> ntfRegisterToken ntf ntfPrivKey (NewNtfTkn deviceToken ntfPubKey pubDhKey)
@@ -1595,7 +1631,7 @@ agentXFTPNewChunk :: AgentClient -> SndFileChunk -> Int -> XFTPServerWithAuth ->
 agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize}, digest = FileDigest chunkDigest} n (ProtoServerWithAuth srv auth) = do
   rKeys <- xftpRcvKeys n
   (sndKey, replicaKey) <- atomically . C.generateAuthKeyPair C.SEd25519 =<< asks random
-  let fileInfo = FileInfo {sndKey, size = fromIntegral chunkSize, digest = chunkDigest}
+  let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
   logServer "-->" c srv "" "FNEW"
   tSess <- liftIO $ mkTransportSession c userId srv chunkDigest
   (sndId, rIds) <- withClient c tSess "FNEW" $ \xftp -> X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth
@@ -1658,7 +1694,7 @@ agentCbDecrypt dhSecret nonce msg =
 
 cryptoError :: C.CryptoError -> AgentErrorType
 cryptoError = \case
-  C.CryptoLargeMsgError -> CMD LARGE
+  C.CryptoLargeMsgError -> CMD LARGE "CryptoLargeMsgError"
   C.CryptoHeaderError _ -> AGENT A_MESSAGE -- parsing error
   C.CERatchetDuplicateMessage -> AGENT A_DUPLICATE
   C.AESDecryptError -> c DECRYPT_AES
@@ -1801,7 +1837,7 @@ storeError = \case
   SEConnDuplicate -> CONN DUPLICATE
   SEBadConnType CRcv -> CONN SIMPLEX
   SEBadConnType CSnd -> CONN SIMPLEX
-  SEInvitationNotFound -> CMD PROHIBITED
+  SEInvitationNotFound -> CMD PROHIBITED "SEInvitationNotFound"
   -- this error is never reported as store error,
   -- it is used to wrap agent operations when "transaction-like" store access is needed
   -- NOTE: network IO should NOT be used inside AgentStoreMonad
@@ -2023,6 +2059,39 @@ getAgentWorkersSummary AgentClient {smpClients, ntfClients, xftpClients, smpDeli
             (pure WorkersSummary {numActive, numIdle = numIdle + 1, totalRestarts = totalRestarts + restartCount})
             (pure WorkersSummary {numActive = numActive + 1, numIdle, totalRestarts = totalRestarts + restartCount})
 
+data AgentQueuesInfo = AgentQueuesInfo
+  { msgQInfo :: TBQueueInfo,
+    subQInfo :: TBQueueInfo,
+    smpClientsQueues :: Map Text (Int, UTCTime, ClientInfo)
+  }
+  deriving (Show)
+
+data ClientInfo
+  = ClientInfoQueues {sndQInfo :: TBQueueInfo, rcvQInfo :: TBQueueInfo}
+  | ClientInfoError {clientError :: (AgentErrorType, Maybe UTCTime)}
+  | ClientInfoConnecting
+  deriving (Show)
+
+getAgentQueuesInfo :: AgentClient -> IO AgentQueuesInfo
+getAgentQueuesInfo AgentClient {msgQ, subQ, smpClients} = do
+  msgQInfo <- atomically $ getTBQueueInfo msgQ
+  subQInfo <- atomically $ getTBQueueInfo subQ
+  smpClientsMap <- readTVarIO smpClients
+  let smpClientsMap' = M.mapKeys (decodeLatin1 . strEncode) smpClientsMap
+  smpClientsQueues <- mapM getClientQueuesInfo smpClientsMap'
+  pure AgentQueuesInfo {msgQInfo, subQInfo, smpClientsQueues}
+  where
+    getClientQueuesInfo :: SMPClientVar -> IO (Int, UTCTime, ClientInfo)
+    getClientQueuesInfo SessionVar {sessionVar, sessionVarId, sessionVarTs} = do
+      clientInfo <-
+        atomically (tryReadTMVar sessionVar) >>= \case
+          Just (Right c) -> do
+            (sndQInfo, rcvQInfo) <- getProtocolClientQueuesInfo $ protocolClient c
+            pure ClientInfoQueues {sndQInfo, rcvQInfo}
+          Just (Left e) -> pure $ ClientInfoError e
+          Nothing -> pure ClientInfoConnecting
+      pure (sessionVarId, sessionVarTs, clientInfo)
+
 $(J.deriveJSON defaultJSON ''AgentLocks)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "TS") ''ProtocolTestStep)
@@ -2041,6 +2110,10 @@ $(J.deriveJSON defaultJSON {J.fieldLabelModifier = takeWhile (/= '_')} ''AgentWo
 
 $(J.deriveJSON defaultJSON ''AgentWorkersSummary)
 
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "ClientInfo") ''ClientInfo)
+
+$(J.deriveJSON defaultJSON ''AgentQueuesInfo)
+
 $(J.deriveJSON (enumJSON $ dropPrefix "UN") ''UserNetworkType)
 
 $(J.deriveJSON defaultJSON ''UserNetworkInfo)

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -54,7 +54,6 @@ import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
-import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
@@ -98,11 +97,11 @@ data AgentConfig = AgentConfig
     connDeleteDeliveryTimeout :: NominalDiffTime,
     helloTimeout :: NominalDiffTime,
     quotaExceededTimeout :: NominalDiffTime,
+    persistErrorInterval :: NominalDiffTime,
     initialCleanupDelay :: Int64,
     cleanupInterval :: Int64,
     cleanupStepInterval :: Int,
     maxWorkerRestartsPerMin :: Int,
-    maxSubscriptionTimeouts :: Int,
     storedMsgDataTTL :: NominalDiffTime,
     rcvFilesTTL :: NominalDiffTime,
     sndFilesTTL :: NominalDiffTime,
@@ -169,13 +168,11 @@ defaultAgentConfig =
       connDeleteDeliveryTimeout = 2 * nominalDay,
       helloTimeout = 2 * nominalDay,
       quotaExceededTimeout = 7 * nominalDay,
+      persistErrorInterval = 3, -- seconds
       initialCleanupDelay = 30 * 1000000, -- 30 seconds
       cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
       cleanupStepInterval = 200000, -- 200ms
       maxWorkerRestartsPerMin = 5,
-      -- 5 consecutive subscription timeouts will result in alert to the user
-      -- this is a fallback, as the timeout set to 3x of expected timeout, to avoid potential locking.
-      maxSubscriptionTimeouts = 5,
       storedMsgDataTTL = 21 * nominalDay,
       rcvFilesTTL = 2 * nominalDay,
       sndFilesTTL = nominalDay,

src/Simplex/Messaging/Agent/Lock.hs

@@ -12,6 +12,8 @@ import Control.Monad (void)
 import Control.Monad.Except (ExceptT (..), runExceptT)
 import Control.Monad.IO.Unlift
 import Data.Functor (($>))
+import Data.Set (Set)
+import qualified Data.Set as S
 import UnliftIO.Async (forConcurrently)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
@@ -39,13 +41,11 @@ withGetLock getLock key name a =
     (atomically . takeTMVar)
     (const a)
 
-withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> [k] -> String -> m a -> m a
+withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> Set k -> String -> m a -> m a
 withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const
   where
-    holdLocks = forConcurrently keys $ \key -> atomically $ getPutLock getLock key name
-    -- only this withGetLocks would be holding the locks,
-    -- so it's safe to combine all lock releases into one transaction
-    releaseLocks = atomically . mapM_ takeTMVar
+    holdLocks = forConcurrently (S.toList keys) $ \key -> atomically $ getPutLock getLock key name
+    releaseLocks = mapM_ (atomically . takeTMVar)
 
 -- getLock and putTMVar can be in one transaction on the assumption that getLock doesn't write in case the lock already exists,
 -- and in case it is created and added to some shared resource (we use TMap) it also helps avoid contention for the newly created lock.

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -33,7 +33,6 @@ import Simplex.Messaging.Agent.Protocol (ACommand (..), APartyCmd (..), AgentErr
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
-import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types

src/Simplex/Messaging/Agent/Protocol.hs

@@ -108,6 +108,7 @@ module Simplex.Messaging.Agent.Protocol
     CRClientData,
     ServiceScheme,
     simplexChat,
+    connReqUriP',
     AgentErrorType (..),
     CommandErrorType (..),
     ConnectionErrorType (..),
@@ -157,8 +158,8 @@ where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad (unless)
-import Control.Monad.Except (runExceptT, throwError)
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
@@ -1161,7 +1162,7 @@ instance StrEncoding MsgReceipt where
     msgRcptStatus <- strP
     pure MsgReceipt {agentMsgId, msgRcptStatus}
 
-instance forall m. ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
+instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
   strEncode = \case
     CRInvitationUri crData e2eParams -> crEncode "invitation" crData (Just e2eParams)
     CRContactUri crData -> crEncode "contact" crData Nothing
@@ -1175,34 +1176,40 @@ instance forall m. ConnectionModeI m => StrEncoding (ConnectionRequestUri m) whe
               [("v", strEncode crAgentVRange), ("smp", strEncode crSmpQueues)]
                 <> maybe [] (\e2e -> [("e2e", strEncode e2e)]) e2eParams
                 <> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData
-  strP = do
-    ACR m cr <- strP
-    case testEquality m $ sConnectionMode @m of
-      Just Refl -> pure cr
-      _ -> fail "bad connection request mode"
+  strP = connReqUriP' (Just SSSimplex)
+
+connReqUriP' :: forall m. ConnectionModeI m => Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
+connReqUriP' overrideScheme = do
+  ACR m cr <- connReqUriP overrideScheme
+  case testEquality m $ sConnectionMode @m of
+    Just Refl -> pure cr
+    _ -> fail "bad connection request mode"
 
 instance StrEncoding AConnectionRequestUri where
   strEncode (ACR _ cr) = strEncode cr
-  strP = do
-    _crScheme :: ServiceScheme <- strP
-    crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?"
-    query <- strP
-    aVRange <- queryParam "v" query
-    crSmpQueues <- queryParam "smp" query
-    let crClientData = safeDecodeUtf8 <$> queryParamStr "data" query
-    let crData = ConnReqUriData {crScheme = SSSimplex, crAgentVRange = aVRange, crSmpQueues, crClientData}
-    case crMode of
-      CMInvitation -> do
-        crE2eParams <- queryParam "e2e" query
-        pure . ACR SCMInvitation $ CRInvitationUri crData crE2eParams
-      -- contact links are adjusted to the minimum version supported by the agent
-      -- to preserve compatibility with the old links published online
-      CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange}
-    where
-      crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact
-      adjustAgentVRange vr =
-        let v = max duplexHandshakeSMPAgentVersion $ minVersion vr
-         in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr)
+  strP = connReqUriP (Just SSSimplex)
+
+connReqUriP :: Maybe ServiceScheme -> Parser AConnectionRequestUri
+connReqUriP overrideScheme = do
+  crScheme <- (`fromMaybe` overrideScheme) <$> strP
+  crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?"
+  query <- strP
+  aVRange <- queryParam "v" query
+  crSmpQueues <- queryParam "smp" query
+  let crClientData = safeDecodeUtf8 <$> queryParamStr "data" query
+      crData = ConnReqUriData {crScheme, crAgentVRange = aVRange, crSmpQueues, crClientData}
+  case crMode of
+    CMInvitation -> do
+      crE2eParams <- queryParam "e2e" query
+      pure . ACR SCMInvitation $ CRInvitationUri crData crE2eParams
+    -- contact links are adjusted to the minimum version supported by the agent
+    -- to preserve compatibility with the old links published online
+    CMContact -> pure . ACR SCMContact $ CRContactUri crData {crAgentVRange = adjustAgentVRange aVRange}
+  where
+    crModeP = "invitation" $> CMInvitation <|> "contact" $> CMContact
+    adjustAgentVRange vr =
+      let v = max duplexHandshakeSMPAgentVersion $ minVersion vr
+        in fromMaybe vr $ safeVersionRange v (max v $ maxVersion vr)
 
 instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
   parseJSON = strParseJSON "ConnectionRequestUri"
@@ -1471,7 +1478,7 @@ instance StrEncoding MsgErrorType where
 -- | Error type used in errors sent to agent clients.
 data AgentErrorType
   = -- | command or response error
-    CMD {cmdErr :: CommandErrorType}
+    CMD {cmdErr :: CommandErrorType, errContext :: String}
   | -- | connection errors
     CONN {connErr :: ConnectionErrorType}
   | -- | SMP protocol errors forwarded to agent clients
@@ -1529,7 +1536,7 @@ data SMPAgentError
   = -- | client or agent message that failed to parse
     A_MESSAGE
   | -- | prohibited SMP/agent message
-    A_PROHIBITED
+    A_PROHIBITED {prohibitedErr :: String}
   | -- | incompatible version of SMP client, agent or encryption protocols
     A_VERSION
   | -- | cannot decrypt message
@@ -1578,7 +1585,7 @@ instance StrEncoding AgentErrorType where
   strP =
     A.takeTill (== ' ')
       >>= \case
-        "CMD" -> CMD <$> (A.space *> parseRead1)
+        "CMD" -> CMD <$> (A.space *> parseRead1) <*> (A.space *> textP)
         "CONN" -> CONN <$> (A.space *> parseRead1)
         "SMP" -> SMP <$> (A.space *> srvP) <*> _strP
         "NTF" -> NTF <$> (A.space *> srvP) <*> _strP
@@ -1593,9 +1600,8 @@ instance StrEncoding AgentErrorType where
         _ -> fail "bad AgentErrorType"
     where
       srvP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
-      textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
   strEncode = \case
-    CMD e -> "CMD " <> bshow e
+    CMD e cxt -> "CMD " <> bshow e <> " " <> text cxt
     CONN e -> "CONN " <> bshow e
     SMP srv e -> "SMP " <> text srv <> " " <> strEncode e
     NTF srv e -> "NTF " <> text srv <> " " <> strEncode e
@@ -1615,20 +1621,23 @@ instance StrEncoding SMPAgentError where
     A.takeTill (== ' ')
       >>= \case
         "MESSAGE" -> pure A_MESSAGE
-        "PROHIBITED" -> pure A_PROHIBITED
+        "PROHIBITED" -> A_PROHIBITED <$> (A.space *> textP)
         "VERSION" -> pure A_VERSION
         "CRYPTO" -> A_CRYPTO <$> _strP
         "DUPLICATE" -> pure A_DUPLICATE
-        "QUEUE" -> A_QUEUE . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
+        "QUEUE" -> A_QUEUE <$> (A.space *> textP)
         _ -> fail "bad SMPAgentError"
   strEncode = \case
     A_MESSAGE -> "MESSAGE"
-    A_PROHIBITED -> "PROHIBITED"
+    A_PROHIBITED e -> "PROHIBITED " <> encodeUtf8 (T.pack e)
     A_VERSION -> "VERSION"
     A_CRYPTO e -> "CRYPTO " <> strEncode e
     A_DUPLICATE -> "DUPLICATE"
     A_QUEUE e -> "QUEUE " <> encodeUtf8 (T.pack e)
 
+textP :: Parser String
+textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
+
 cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState
 cryptoErrToSyncState = \case
   DECRYPT_AES -> RSAllowed
@@ -1841,7 +1850,7 @@ commandP binaryP =
             sd : rds -> SFDONE <$> strDecode (encodeUtf8 sd) <*> mapM (strDecode . encodeUtf8) rds
 
 parseCommand :: ByteString -> Either AgentErrorType ACmd
-parseCommand = parse (commandP A.takeByteString) $ CMD SYNTAX
+parseCommand = parse (commandP A.takeByteString) $ CMD SYNTAX "parseCommand"
 
 -- | Serialize SMP agent command.
 serializeCommand :: ACommand p e -> ByteString
@@ -1931,7 +1940,7 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
     fromParty :: ACmd -> Either AgentErrorType (APartyCmd p)
     fromParty (ACmd (p :: p1) e cmd) = case testEquality party p of
       Just Refl -> Right $ APC e cmd
-      _ -> Left $ CMD PROHIBITED
+      _ -> Left $ CMD PROHIBITED "fromParty"
 
     tConnId :: ARawTransmission -> APartyCmd p -> Either AgentErrorType (APartyCmd p)
     tConnId (_, entId, _) (APC e cmd) =
@@ -1949,7 +1958,7 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
         SUSPENDED {} -> Right cmd
         -- other responses must have connection ID
         _
-          | B.null entId -> Left $ CMD NO_CONN
+          | B.null entId -> Left $ CMD NO_CONN "tConnId"
           | otherwise -> Right cmd
 
     cmdWithMsgBody :: APartyCmd p -> IO (Either AgentErrorType (APartyCmd p))
@@ -1972,11 +1981,11 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody
         str -> case readMaybe str :: Maybe Int of
           Just size -> runExceptT $ do
             body <- liftIO $ cGet h size
-            unless (B.length body == size) $ throwError $ CMD SIZE
+            unless (B.length body == size) $ throwE $ CMD SIZE "getBody"
             s <- liftIO $ getLn h
-            unless (B.null s) $ throwError $ CMD SIZE
+            unless (B.null s) $ throwE $ CMD SIZE "getBody"
             pure body
-          Nothing -> return . Left $ CMD SYNTAX
+          Nothing -> pure . Left $ CMD SYNTAX "getBody"
 
 $(J.deriveJSON defaultJSON ''RcvQueueInfo)
 

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -2284,7 +2284,7 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath file
       forM_ (zip [1 ..] replicas) $ \(rno, replica) -> insertRcvFileChunkReplica db rno replica chunkId
   pure rcvFileEntityId
 
-createRcvFileRedirect :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
+createRcvFileRedirect :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
 createRcvFileRedirect _ _ _ FileDescription {redirect = Nothing} _ _ _ _ _ _ = pure $ Left $ SEInternal "createRcvFileRedirect called without redirect"
 createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redirectChunks, redirect = Just RedirectFileInfo {size, digest}} prefixPath redirectPath redirectFile dstPath dstFile approvedRelays = runExceptT $ do
   (dstEntityId, dstId) <- ExceptT $ insertRcvFile db gVar userId dummyDst prefixPath dstPath dstFile Nothing Nothing approvedRelays

src/Simplex/Messaging/Client.hs

@@ -59,6 +59,7 @@ module Simplex.Messaging.Client
     connectSMPProxiedRelay,
     proxySMPMessage,
     forwardSMPMessage,
+    getSMPQueueInfo,
     sendProtocolCommand,
 
     -- * Supporting types and client configuration
@@ -90,6 +91,11 @@ module Simplex.Messaging.Client
     mkTransmission,
     authTransmission,
     smpClientStub,
+
+    -- * For debugging
+    TBQueueInfo (..),
+    getTBQueueInfo,
+    getProtocolClientQueuesInfo,
   )
 where
 
@@ -123,6 +129,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
@@ -154,7 +161,7 @@ data PClient v err msg = PClient
     timeoutErrorCount :: TVar Int,
     clientCorrId :: TVar ChaChaDRG,
     sentCommands :: TMap CorrId (Request err msg),
-    sndQ :: TBQueue ByteString,
+    sndQ :: TBQueue (Maybe (TVar Bool), ByteString),
     rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)),
     msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
   }
@@ -284,6 +291,32 @@ data SMPProxyFallback
   | SPFProhibit -- prohibit direct connection to destination relay.
   deriving (Eq, Show)
 
+instance StrEncoding SMPProxyMode where
+  strEncode = \case
+    SPMAlways -> "always"
+    SPMUnknown -> "unknown"
+    SPMUnprotected -> "unprotected"
+    SPMNever -> "never"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "always" -> pure SPMAlways
+      "unknown" -> pure SPMUnknown
+      "unprotected" -> pure SPMUnprotected
+      "never" -> pure SPMNever
+      _ -> fail "Invalid SMP proxy mode"
+
+instance StrEncoding SMPProxyFallback where
+  strEncode = \case
+    SPFAllow -> "yes"
+    SPFAllowProtected -> "protected"
+    SPFProhibit -> "no"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "yes" -> pure SPFAllow
+      "protected" -> pure SPFAllowProtected
+      "no" -> pure SPFProhibit
+      _ -> fail "Invalid SMP proxy fallback mode"
+
 defaultNetworkConfig :: NetworkConfig
 defaultNetworkConfig =
   NetworkConfig
@@ -474,7 +507,11 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
             `finally` disconnected c'
 
     send :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
-    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= void . tPutLog h
+    send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= sendPending
+      where
+        sendPending (Nothing, s) = send_ s
+        sendPending (Just pending, s) = whenM (readTVarIO pending) $ send_ s
+        send_ = void . tPutLog h
 
     receive :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
     receive ProtocolClient {client_ = PClient {rcvQ, lastReceived, timeoutErrorCount}} h = forever $ do
@@ -911,6 +948,12 @@ forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId =
       pure fwdResponse
     r -> throwE $ unexpectedResponse r
 
+getSMPQueueInfo :: SMPClient -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO QueueInfo
+getSMPQueueInfo c pKey qId =
+  sendSMPCommand c (Just pKey) qId QUE >>= \case
+    INFO info -> pure info
+    r -> throwE $ unexpectedResponse r
+
 okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
 okSMPCommand cmd c pKey qId =
   sendSMPCommand c (Just pKey) qId cmd >>= \case
@@ -965,29 +1008,33 @@ sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
       pure [Response entityId $ Left $ PCETransportError e]
     TBTransmissions s n rs
       | n > 0 -> do
-          atomically $ writeTBQueue sndQ s
+          atomically $ writeTBQueue sndQ (Nothing, s) -- do not expire batched responses
           mapConcurrently (getResponse c Nothing) rs
       | otherwise -> pure []
     TBTransmission s r -> do
-      atomically $ writeTBQueue sndQ s
+      atomically $ writeTBQueue sndQ (Nothing, s)
       (: []) <$> getResponse c Nothing r
 
 -- | Send Protocol command
 sendProtocolCommand :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
 sendProtocolCommand c = sendProtocolCommand_ c Nothing Nothing
 
+-- Currently there is coupling - batch commands do not expire, and individually sent commands do.
+-- This is to reflect the fact that we send subscriptions only as batches, and also because we do not track a separate timeout for the whole batch, so it is not obvious when should we expire it.
+-- We could expire a batch of deletes, for example, either when the first response expires or when the last one does.
+-- But a better solution is to process delayed delete responses.
 sendProtocolCommand_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.CbNonce -> Maybe Int -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
 sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THandleParams {batch, blockSize}} nonce_ tOut pKey entId cmd =
   ExceptT $ uncurry sendRecv =<< mkTransmission_ c nonce_ (pKey, entId, cmd)
   where
     -- two separate "atomically" needed to avoid blocking
     sendRecv :: Either TransportError SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg)
-    sendRecv t_ r = case t_ of
+    sendRecv t_ r@Request {pending} = case t_ of
       Left e -> pure . Left $ PCETransportError e
       Right t
         | B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg
         | otherwise -> do
-            atomically $ writeTBQueue sndQ s
+            atomically $ writeTBQueue sndQ (Just pending, s)
             response <$> getResponse c tOut r
         where
           s
@@ -1046,6 +1093,24 @@ authTransmission thAuth pKey_ nonce t = traverse authenticate pKey_
     sign :: forall a. (C.AlgorithmI a, C.SignatureAlgorithm a) => C.PrivateKey a -> Either TransportError TransmissionAuth
     sign pk = Right $ TASignature $ C.ASignature (C.sAlgorithm @a) (C.sign' pk t)
 
+data TBQueueInfo = TBQueueInfo
+  { qLength :: Int,
+    qFull :: Bool
+  }
+  deriving (Show)
+
+getTBQueueInfo :: TBQueue a -> STM TBQueueInfo
+getTBQueueInfo q = do
+  qLength <- fromIntegral <$> lengthTBQueue q
+  qFull <- isFullTBQueue q
+  pure TBQueueInfo {qLength, qFull}
+
+getProtocolClientQueuesInfo :: ProtocolClient v err msg -> IO (TBQueueInfo, TBQueueInfo)
+getProtocolClientQueuesInfo ProtocolClient {client_ = PClient {sndQ, rcvQ}} = do
+  sndQInfo <- atomically $ getTBQueueInfo sndQ
+  rcvQInfo <- atomically $ getTBQueueInfo rcvQ
+  pure (sndQInfo, rcvQInfo)
+
 $(J.deriveJSON (enumJSON $ dropPrefix "HM") ''HostMode)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "SM") ''SocksMode)
@@ -1059,3 +1124,5 @@ $(J.deriveJSON (enumJSON $ dropPrefix "SPF") ''SMPProxyFallback)
 $(J.deriveJSON defaultJSON ''NetworkConfig)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "Proxy") ''ProxyClientError)
+
+$(J.deriveJSON defaultJSON ''TBQueueInfo)

src/Simplex/Messaging/Client/Agent.hs

@@ -9,7 +9,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Client.Agent where
 
@@ -21,7 +20,6 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
-import Control.Monad.Trans.Reader
 import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (bimap, first)
 import Data.ByteString.Char8 (ByteString)
@@ -47,10 +45,9 @@ import Simplex.Messaging.Session
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, ifM, toChunks, whenM, ($>>=))
+import Simplex.Messaging.Util (catchAll_, ifM, toChunks, whenM, ($>>=), (<$$>))
 import System.Timeout (timeout)
 import UnliftIO (async)
-import UnliftIO.Exception (Exception)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
@@ -89,7 +86,7 @@ defaultSMPClientAgentConfig =
             increaseAfter = 10 * second,
             maxInterval = 10 * second
           },
-      persistErrorInterval = 0,
+      persistErrorInterval = 30, -- seconds
       msgQSize = 256,
       agentQSize = 256,
       agentSubsBatchSize = 900,
@@ -114,31 +111,6 @@ data SMPClientAgent = SMPClientAgent
 
 type OwnServer = Bool
 
-newtype InternalException e = InternalException {unInternalException :: e}
-  deriving (Eq, Show)
-
-instance Exception e => Exception (InternalException e)
-
-instance Exception e => MonadUnliftIO (ExceptT e IO) where
-  {-# INLINE withRunInIO #-}
-  withRunInIO :: ((forall a. ExceptT e IO a -> IO a) -> IO b) -> ExceptT e IO b
-  withRunInIO inner =
-    ExceptT . fmap (first unInternalException) . E.try $
-      withRunInIO $ \run ->
-        inner $ run . (either (E.throwIO . InternalException) pure <=< runExceptT)
-
--- as MonadUnliftIO instance for IO is `withRunInIO inner = inner id`,
--- the last two lines could be replaced with:
--- inner $ either (E.throwIO . InternalException) pure <=< runExceptT
-
-instance Exception e => MonadUnliftIO (ExceptT e (ReaderT r IO)) where
-  {-# INLINE withRunInIO #-}
-  withRunInIO :: ((forall a. ExceptT e (ReaderT r IO) a -> IO a) -> IO b) -> ExceptT e (ReaderT r IO) b
-  withRunInIO inner =
-    withExceptT unInternalException . ExceptT . E.try $
-      withRunInIO $ \run ->
-        inner $ run . (either (E.throwIO . InternalException) pure <=< runExceptT)
-
 newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
   active <- newTVar True
@@ -171,10 +143,11 @@ getSMPServerClient' ca srv = snd <$> getSMPServerClient'' ca srv
 {-# INLINE getSMPServerClient' #-}
 
 getSMPServerClient'' :: SMPClientAgent -> SMPServer -> ExceptT SMPClientError IO (OwnServer, SMPClient)
-getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, workerSeq} srv =
-  atomically getClientVar >>= either (ExceptT . newSMPClient) waitForSMPClient
+getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, workerSeq} srv = do
+  ts <- liftIO getCurrentTime
+  atomically (getClientVar ts) >>= either (ExceptT . newSMPClient) waitForSMPClient
   where
-    getClientVar :: STM (Either SMPClientVar SMPClientVar)
+    getClientVar :: UTCTime -> STM (Either SMPClientVar SMPClientVar)
     getClientVar = getSessVar workerSeq srv smpClients
 
     waitForSMPClient :: SMPClientVar -> ExceptT SMPClientError IO (OwnServer, SMPClient)
@@ -183,12 +156,13 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
       smpClient_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar v)
       case smpClient_ of
         Just (Right smpClient) -> pure smpClient
-        Just (Left (e, Nothing)) -> throwE e
-        Just (Left (e, Just ts)) ->
-          ifM
-            ((ts <) <$> liftIO getCurrentTime)
-            (atomically (removeSessVar v srv smpClients) >> getSMPServerClient'' ca srv)
-            (throwE e)
+        Just (Left (e, ts_)) -> case ts_ of
+          Nothing -> throwE e
+          Just ts ->
+            ifM
+              ((ts <) <$> liftIO getCurrentTime)
+              (atomically (removeSessVar v srv smpClients) >> getSMPServerClient'' ca srv)
+              (throwE e)
         Nothing -> throwE PCEResponseTimeout
 
     newSMPClient :: SMPClientVar -> IO (Either SMPClientError (OwnServer, SMPClient))
@@ -204,12 +178,13 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
           notify ca $ CAConnected srv
           pure $ Right c
         Left e -> do
-          if persistErrorInterval agentCfg == 0 || e == PCENetworkError || e == PCEResponseTimeout
+          let ei = persistErrorInterval agentCfg
+          if ei == 0
             then atomically $ do
               putTMVar (sessionVar v) (Left (e, Nothing))
               removeSessVar v srv smpClients
             else do
-              ts <- addUTCTime (persistErrorInterval agentCfg) <$> liftIO getCurrentTime
+              ts <- addUTCTime ei <$> liftIO getCurrentTime
               atomically $ putTMVar (sessionVar v) (Left (e, Just ts))
           reconnectClient ca srv
           pure $ Left e
@@ -253,14 +228,15 @@ connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, random
 
 -- | Spawn reconnect worker if needed
 reconnectClient :: SMPClientAgent -> SMPServer -> IO ()
-reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} srv =
-  whenM (readTVarIO active) $ atomically getWorkerVar >>= mapM_ (either newSubWorker (\_ -> pure ()))
+reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} srv = do
+  ts <- getCurrentTime
+  whenM (readTVarIO active) $ atomically (getWorkerVar ts) >>= mapM_ (either newSubWorker (\_ -> pure ()))
   where
-    getWorkerVar =
+    getWorkerVar ts =
       ifM
         (null <$> getPending)
         (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
-        (Just <$> getSessVar workerSeq srv smpSubWorkers)
+        (Just <$> getSessVar workerSeq srv smpSubWorkers ts)
     newSubWorker :: SessionVar (Async ()) -> IO ()
     newSubWorker v = do
       a <- async $ void (E.tryAny runSubWorker) >> atomically (cleanup v)
@@ -313,6 +289,20 @@ notify :: MonadIO m => SMPClientAgent -> SMPClientAgentEvent -> m ()
 notify ca evt = atomically $ writeTBQueue (agentQ ca) evt
 {-# INLINE notify #-}
 
+-- Returns already connected client for proxying messages or Nothing if client is absent, not connected yet or stores expired error.
+-- If Nothing is return proxy will spawn a new thread to wait or to create another client connection to destination relay.
+getConnectedSMPServerClient :: SMPClientAgent -> SMPServer -> IO (Maybe (Either SMPClientError (OwnServer, SMPClient)))
+getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
+  atomically (TM.lookup srv smpClients $>>= \v -> (v,) <$$> tryReadTMVar (sessionVar v)) -- Nothing: client is absent or not connected yet
+    $>>= \case
+      (_, Right r) -> pure $ Just $ Right r
+      (v, Left (e, ts_)) ->
+        pure ts_ $>>= \ts ->  -- proxy will create a new connection if ts_ is Nothing
+          ifM
+            ((ts <) <$> liftIO getCurrentTime) -- error persistence interval period expired?
+            (Nothing <$ atomically (removeSessVar v srv smpClients)) -- proxy will create a new connection
+            (pure $ Just $ Left e) -- not expired, returning error
+
 lookupSMPServerClient :: SMPClientAgent -> SessionId -> STM (Maybe (OwnServer, SMPClient))
 lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookup sessId smpSessions
 

src/Simplex/Messaging/Crypto.hs

@@ -185,6 +185,9 @@ module Simplex.Messaging.Crypto
     maxLenBS,
     unsafeMaxLenBS,
     appendMaxLenBS,
+    hsalsa20,
+    secretBox,
+    secretBoxOpen,
   )
 where
 
@@ -195,10 +198,8 @@ import Control.Monad.Except
 import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
-import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
 import Crypto.Hash (Digest, SHA256 (..), SHA512 (..), hash, hashDigestSize)
-import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
 import qualified Crypto.PubKey.Ed25519 as Ed25519
@@ -228,12 +229,15 @@ import Data.X509
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
+import Foreign.C.ConstPtr (ConstPtr (..))
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
+import qualified Simplex.Messaging.Crypto.NaCl.Bindings as NaCl
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
+import System.IO.Unsafe (unsafePerformIO)
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1210,10 +1214,7 @@ cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> B
 cbEncryptMaxLenBS (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce . unMaxLenBS . padMaxLenBS
 
 cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
-cryptoBox secret nonce s = BA.convert tag <> c
-  where
-    (rs, c) = xSalsa20 secret nonce s
-    tag = Poly1305.auth rs c
+cryptoBox secret nonce msg = either error id $! hsalsa20 secret >>= \sk -> secretBox sk nonce msg -- TODO: fuse
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
 cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
@@ -1233,14 +1234,7 @@ sbDecrypt_ secret nonce = unPad <=< sbDecryptNoPad_ secret nonce
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
 sbDecryptNoPad_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
-sbDecryptNoPad_ secret (CbNonce nonce) packet
-  | B.length packet < 16 = Left CBDecryptError
-  | BA.constEq tag' tag = Right msg
-  | otherwise = Left CBDecryptError
-  where
-    (tag', c) = B.splitAt 16 packet
-    (rs, msg) = xSalsa20 secret nonce c
-    tag = Poly1305.auth rs c
+sbDecryptNoPad_ secret (CbNonce nonce) packet = first (const CBDecryptError) $! hsalsa20 secret >>= \sk -> secretBoxOpen sk nonce packet -- TODO: fuse
 
 -- type for authentication scheme using NaCl @crypto_box@ over the sha512 digest of the message.
 newtype CbAuthenticator = CbAuthenticator ByteString deriving (Eq, Show)
@@ -1334,16 +1328,6 @@ unsafeSbKey s = either error id $ sbKey s
 randomSbKey :: TVar ChaChaDRG -> STM SbKey
 randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar
 
-xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
-xSalsa20 secret nonce msg = (rs, msg')
-  where
-    zero = B.replicate 16 $ toEnum 0
-    (iv0, iv1) = B.splitAt 8 nonce
-    state0 = XSalsa.initialize 20 secret (zero `B.append` iv0)
-    state1 = XSalsa.derive state0 iv1
-    (rs, state2) = XSalsa.generate state1 32
-    (msg', _) = XSalsa.combine state2 msg
-
 publicToX509 :: PublicKey a -> PubKey
 publicToX509 = \case
   PublicKeyEd25519 k -> PubKeyEd25519 k
@@ -1392,3 +1376,53 @@ keyError :: (a, [ASN1]) -> Either String b
 keyError = \case
   (_, []) -> Left "unknown key algorithm"
   _ -> Left "more than one key"
+
+type NaclDhSecret = BA.ScrubbedBytes
+
+-- type NaclDhSecret = C.DhSecret 'C.X25519h -- hashed DH produced by NaCl "crypto_box_beforenm" and used by secretBox/Open
+
+-- Run salsa20 in a hash mode to make our DH keys match 'c_crypto_box_beforenm' output.
+hsalsa20 :: ByteArrayAccess key => key -> Either String NaclDhSecret
+hsalsa20 key = unsafePerformIO $ do
+  (r, ba :: NaclDhSecret) <- BA.withByteArray c_0 $ \inpPtr ->
+    BA.withByteArray key $ \keyPtr ->
+      BA.withByteArray sigma $ \sigmaPtr ->
+        BA.allocRet 32 $ \outPtr ->
+          NaCl.c_crypto_core_hsalsa20 outPtr (ConstPtr inpPtr) (ConstPtr keyPtr) (ConstPtr sigmaPtr)
+  pure $! if r /= 0 then Left "crypto_core_hsalsa20" else Right ba
+  where
+    -- sigma[16] = "expand 32-byte k";
+    sigma :: ByteString
+    sigma = "expand 32-byte k"
+    c_0 :: ByteString
+    c_0 = B.replicate 16 '\0'
+{-# NOINLINE hsalsa20 #-}
+
+secretBox :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString
+secretBox sk nonce msg = unsafePerformIO $ do
+  (r, c) <-
+    BA.withByteArray msg0 $ \mPtr ->
+      BA.withByteArray nonce $ \noncePtr ->
+        BA.withByteArray sk $ \skPtr ->
+          BA.allocRet (B.length msg0) $ \cPtr ->
+            NaCl.c_crypto_secretbox cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr noncePtr) (ConstPtr skPtr)
+  pure $! if r /= 0 then Left "crypto_secretbox" else Right (B.drop NaCl.crypto_box_BOXZEROBYTES c)
+  where
+    zeroBytes = B.replicate NaCl.crypto_box_ZEROBYTES '\0'
+    msg0 = zeroBytes <> BA.convert msg
+{-# NOINLINE secretBox #-}
+
+secretBoxOpen :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString
+secretBoxOpen sk nonce ciphertext = unsafePerformIO $ do
+  (r, m) <-
+    BA.withByteArray ciphertext0 $ \cPtr ->
+      BA.withByteArray nonce $ \noncePtr ->
+        BA.withByteArray sk $ \skPtr ->
+          BA.allocRet cLen $ \mPtr ->
+            NaCl.c_crypto_secretbox_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr noncePtr) (ConstPtr skPtr)
+  pure $! if r /= 0 then Left "crypto_secretbox_open" else Right (B.drop NaCl.crypto_box_ZEROBYTES m)
+  where
+    ciphertext0 = boxZeroBytes <> ciphertext
+    boxZeroBytes = B.replicate NaCl.crypto_box_BOXZEROBYTES '\0'
+    cLen = B.length ciphertext0
+{-# NOINLINE secretBoxOpen #-}

src/Simplex/Messaging/Crypto/File.hs

@@ -31,7 +31,6 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isJust)
-import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Lazy (LazyByteString)
 import qualified Simplex.Messaging.Crypto.Lazy as LC

src/Simplex/Messaging/Crypto/NaCl/Bindings.hs

@@ -0,0 +1,102 @@
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use camelCase" #-}
+
+module Simplex.Messaging.Crypto.NaCl.Bindings where
+
+import Data.ByteArray (ScrubbedBytes)
+import Foreign
+import Foreign.C.Types
+
+#if MIN_VERSION_base(4,18,0)
+import Foreign.C.ConstPtr
+#else
+type ConstPtr = Ptr
+pattern ConstPtr :: p -> p
+pattern ConstPtr p = p
+#endif
+
+crypto_box_PUBLICKEYBYTES :: Num a => a
+crypto_box_PUBLICKEYBYTES = 32
+
+crypto_box_SECRETKEYBYTES :: Num a => a
+crypto_box_SECRETKEYBYTES = 32
+
+crypto_box_BEFORENMBYTES :: Num a => a
+crypto_box_BEFORENMBYTES = 32
+
+crypto_box_NONCEBYTES :: Num a => a
+crypto_box_NONCEBYTES = 24
+
+crypto_box_ZEROBYTES :: Num a => a
+crypto_box_ZEROBYTES = 32
+
+crypto_box_BOXZEROBYTES :: Num a => a
+crypto_box_BOXZEROBYTES = 16
+
+-- int crypto_box(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *y,const u8 *x)
+-- {
+--   u8 k[32];
+--   crypto_box_beforenm(k,y,x);
+--   return crypto_box_afternm(c,m,d,n,k);
+-- }
+foreign import capi "tweetnacl.h crypto_box"
+  c_crypto_box :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+-- int crypto_box_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *y,const u8 *x)
+-- {
+--   u8 k[32];
+--   crypto_box_beforenm(k,y,x);
+--   return crypto_box_open_afternm(m,c,d,n,k);
+-- }
+foreign import capi "crypto_box_open"
+  c_crypto_box_open :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+-- XXX: requires randombytes extern symbol available. Not relevant as we can random it ourselves.
+-- foreign import ccall "crypto_box_keypair"
+--   c_crypto_box_keypair :: Ptr Word8 -> Ptr Word8 -> IO CInt
+
+foreign import capi "tweetnacl.h crypto_scalarmult"
+  crypto_scalarmult :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+-- XXX: does NOT result in the same DH key we/crypton use as it throws HSalsa20 at the result of the scalarmult op above
+-- int crypto_box_beforenm(u8 *k,const u8 *y,const u8 *x)
+-- {
+--   u8 s[32];
+--   crypto_scalarmult(s,x,y);
+--   return crypto_core_hsalsa20(k,_0,s,sigma);
+-- }
+foreign import capi "tweetnacl.h crypto_box_beforenm"
+  c_crypto_box_beforenm :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+foreign import capi "tweetnacl.h crypto_core_hsalsa20"
+  c_crypto_core_hsalsa20 :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+foreign import capi "tweetnacl.h crypto_secretbox"
+  c_crypto_secretbox :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+foreign import capi "tweetnacl.h crypto_secretbox_open"
+  c_crypto_secretbox_open :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+-- type NaclDhSecret = C.DhSecret 'C.X25519
+type NaclDhSecret = ScrubbedBytes
+
+-- int crypto_box_afternm(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
+-- {
+--   return crypto_secretbox(c,m,d,n,k);
+-- }
+foreign import capi "tweetnacl.h crypto_box_afternm"
+  c_crypto_box_afternm :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
+
+-- int crypto_box_open_afternm(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k)
+-- {
+--   return crypto_secretbox_open(m,c,d,n,k);
+-- }
+foreign import capi "tweetnacl.h crypto_box_open_afternm"
+  c_crypto_box_open_afternm :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -166,9 +166,9 @@ instance TestEquality SRatchetKEMState where
 
 class RatchetKEMStateI (s :: RatchetKEMState) where sRatchetKEMState :: SRatchetKEMState s
 
-instance RatchetKEMStateI RKSProposed where sRatchetKEMState = SRKSProposed
+instance RatchetKEMStateI 'RKSProposed where sRatchetKEMState = SRKSProposed
 
-instance RatchetKEMStateI RKSAccepted where sRatchetKEMState = SRKSAccepted
+instance RatchetKEMStateI 'RKSAccepted where sRatchetKEMState = SRKSAccepted
 
 checkRatchetKEMState :: forall t s s' a. (RatchetKEMStateI s, RatchetKEMStateI s') => t s' a -> Either String (t s a)
 checkRatchetKEMState x = case testEquality (sRatchetKEMState @s) (sRatchetKEMState @s') of

src/Simplex/Messaging/Notifications/Server/Main.hs

@@ -11,9 +11,10 @@ import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
-import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
+import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..), defaultInactiveClientExpiration)
@@ -25,6 +26,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
+import Simplex.Messaging.Util (tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -65,7 +67,7 @@ ntfServerCLI cfgPath logPath =
       fp <- createServerX509 cfgPath x509cfg
       let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
           srv = ProtoServerWithAuth (NtfServer [THDomainName host] "" (C.KeyHash fp)) Nothing
-      writeFile iniFile $ iniFileContent host
+      T.writeFile iniFile $ iniFileContent host
       putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
       warnCAPrivateKeyFile cfgPath x509cfg
       printServiceInfo serverVersion srv
@@ -81,15 +83,15 @@ ntfServerCLI cfgPath logPath =
             <> "log_stats: off\n\n\
                \[TRANSPORT]\n\
                \# host is only used to print server address on start\n"
-            <> ("host: " <> host <> "\n")
-            <> ("port: " <> defaultServerPort <> "\n")
+            <> ("host: " <> T.pack host <> "\n")
+            <> ("port: " <> T.pack defaultServerPort <> "\n")
             <> "log_tls_errors: off\n"
             <> "websockets: off\n\n\
                \[INACTIVE_CLIENTS]\n\
                \# TTL and interval to check inactive clients\n\
                \disconnect: off\n"
-            <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-            <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
+            <> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
+            <> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
     runServer ini = do
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
@@ -113,7 +115,7 @@ ntfServerCLI cfgPath logPath =
               clientQSize = 64,
               subQSize = 512,
               pushQSize = 1048,
-              smpAgentCfg = defaultSMPClientAgentConfig,
+              smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
               apnsConfig = defaultAPNSPushClientConfig,
               subsBatchSize = 900,
               inactiveClientExpiration =

src/Simplex/Messaging/Protocol.hs

@@ -156,6 +156,7 @@ module Simplex.Messaging.Protocol
     sameSrvAddr,
     sameSrvAddr',
     noAuthSrv,
+    toMsgInfo,
 
     -- * TCP transport functions
     TransportBatch (..),
@@ -197,8 +198,8 @@ import qualified Data.List.NonEmpty as L
 import Data.Maybe (isJust, isNothing)
 import Data.String
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-import Data.Time.Clock.System (SystemTime (..))
+import Data.Text.Encoding (decodeLatin1, encodeUtf8)
+import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
 import Data.Type.Equality
 import Data.Word (Word16)
 import qualified Data.X509 as X
@@ -210,6 +211,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
+import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.ServiceScheme
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
@@ -386,6 +388,7 @@ data Command (p :: Party) where
   ACK :: MsgId -> Command Recipient
   OFF :: Command Recipient
   DEL :: Command Recipient
+  QUE :: Command Recipient
   -- SMP sender commands
   -- SEND v1 has to be supported for encoding/decoding
   -- SEND :: MsgBody -> Command Sender
@@ -463,6 +466,7 @@ data BrokerMsg where
   RRES :: EncFwdResponse -> BrokerMsg -- relay to proxy
   PRES :: EncResponse -> BrokerMsg -- proxy to client
   END :: BrokerMsg
+  INFO :: QueueInfo -> BrokerMsg
   OK :: BrokerMsg
   ERR :: ErrorType -> BrokerMsg
   PONG :: BrokerMsg
@@ -505,6 +509,13 @@ data Message
         msgTs :: SystemTime
       }
 
+toMsgInfo :: Message -> MsgInfo
+toMsgInfo = \case
+  Message {msgId, msgTs} -> msgInfo msgId msgTs MTMessage
+  MessageQuota {msgId, msgTs} -> msgInfo msgId msgTs MTQuota
+  where
+    msgInfo msgId msgTs msgType = MsgInfo {msgId = decodeLatin1 $ B64.encode msgId, msgTs = systemToUTCTime msgTs, msgType}
+
 messageId :: Message -> MsgId
 messageId = \case
   Message {msgId} -> msgId
@@ -652,6 +663,7 @@ data CommandTag (p :: Party) where
   ACK_ :: CommandTag Recipient
   OFF_ :: CommandTag Recipient
   DEL_ :: CommandTag Recipient
+  QUE_ :: CommandTag Recipient
   SEND_ :: CommandTag Sender
   PING_ :: CommandTag Sender
   PRXY_ :: CommandTag ProxiedClient
@@ -674,6 +686,7 @@ data BrokerMsgTag
   | RRES_
   | PRES_
   | END_
+  | INFO_
   | OK_
   | ERR_
   | PONG_
@@ -698,6 +711,7 @@ instance PartyI p => Encoding (CommandTag p) where
     ACK_ -> "ACK"
     OFF_ -> "OFF"
     DEL_ -> "DEL"
+    QUE_ -> "QUE"
     SEND_ -> "SEND"
     PING_ -> "PING"
     PRXY_ -> "PRXY"
@@ -717,6 +731,7 @@ instance ProtocolMsgTag CmdTag where
     "ACK" -> Just $ CT SRecipient ACK_
     "OFF" -> Just $ CT SRecipient OFF_
     "DEL" -> Just $ CT SRecipient DEL_
+    "QUE" -> Just $ CT SRecipient QUE_
     "SEND" -> Just $ CT SSender SEND_
     "PING" -> Just $ CT SSender PING_
     "PRXY" -> Just $ CT SProxiedClient PRXY_
@@ -742,6 +757,7 @@ instance Encoding BrokerMsgTag where
     RRES_ -> "RRES"
     PRES_ -> "PRES"
     END_ -> "END"
+    INFO_ -> "INFO"
     OK_ -> "OK"
     ERR_ -> "ERR"
     PONG_ -> "PONG"
@@ -757,6 +773,7 @@ instance ProtocolMsgTag BrokerMsgTag where
     "RRES" -> Just RRES_
     "PRES" -> Just PRES_
     "END" -> Just END_
+    "INFO" -> Just INFO_
     "OK" -> Just OK_
     "ERR" -> Just ERR_
     "PONG" -> Just PONG_
@@ -1275,6 +1292,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     ACK msgId -> e (ACK_, ' ', msgId)
     OFF -> e OFF_
     DEL -> e DEL_
+    QUE -> e QUE_
     SEND flags msg -> e (SEND_, ' ', flags, ' ', Tail msg)
     PING -> e PING_
     NSUB -> e NSUB_
@@ -1340,6 +1358,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
         ACK_ -> ACK <$> _smpP
         OFF_ -> pure OFF
         DEL_ -> pure DEL
+        QUE_ -> pure QUE
     CT SSender tag ->
       Cmd SSender <$> case tag of
         SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
@@ -1368,6 +1387,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     RRES (EncFwdResponse encBlock) -> e (RRES_, ' ', Tail encBlock)
     PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
     END -> e END_
+    INFO info -> e (INFO_, ' ', info)
     OK -> e OK_
     ERR err -> e (ERR_, ' ', err)
     PONG -> e PONG_
@@ -1388,6 +1408,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     RRES_ -> RRES <$> (EncFwdResponse . unTail <$> _smpP)
     PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
     END_ -> pure END
+    INFO_ -> INFO <$> _smpP
     OK_ -> pure OK
     ERR_ -> ERR <$> _smpP
     PONG_ -> pure PONG

src/Simplex/Messaging/Server.hs

@@ -59,7 +59,7 @@ import Data.List (intercalate, mapAccumR)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (isNothing)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
@@ -70,8 +70,8 @@ import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
 import Simplex.Messaging.Agent.Lock
-import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), forwardSMPMessage, smpProxyError, temporaryClientError)
-import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient)
+import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, forwardSMPMessage, smpProxyError, temporaryClientError)
+import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -82,6 +82,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore
+import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.QueueStore.STM as QS
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog
@@ -103,7 +104,6 @@ import UnliftIO.IO
 import UnliftIO.STM
 #if MIN_VERSION_base(4,18,0)
 import Data.List (sort)
-import Data.Maybe (fromMaybe)
 import GHC.Conc (listThreads, threadStatus)
 import GHC.Conc.Sync (threadLabel)
 #endif
@@ -229,7 +229,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, msgSent, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
+      ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv} <- asks serverStats
       let interval = 1000000 * logInterval
       forever $ do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -241,7 +241,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           qDeletedAll' <- atomically $ swapTVar qDeletedAll 0
           qDeletedNew' <- atomically $ swapTVar qDeletedNew 0
           qDeletedSecured' <- atomically $ swapTVar qDeletedSecured 0
+          qSub' <- atomically $ swapTVar qSub 0
+          qSubAuth' <- atomically $ swapTVar qSubAuth 0
+          qSubDuplicate' <- atomically $ swapTVar qSubDuplicate 0
+          qSubProhibited' <- atomically $ swapTVar qSubProhibited 0
           msgSent' <- atomically $ swapTVar msgSent 0
+          msgSentAuth' <- atomically $ swapTVar msgSentAuth 0
+          msgSentQuota' <- atomically $ swapTVar msgSentQuota 0
+          msgSentLarge' <- atomically $ swapTVar msgSentLarge 0
           msgRecv' <- atomically $ swapTVar msgRecv 0
           msgExpired' <- atomically $ swapTVar msgExpired 0
           ps <- atomically $ periodStatCounts activeQueues ts
@@ -282,7 +289,15 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                   <> showProxyStats pRelaysOwn'
                   <> showProxyStats pMsgFwds'
                   <> showProxyStats pMsgFwdsOwn'
-                  <> [show pMsgFwdsRecv']
+                  <> [ show pMsgFwdsRecv',
+                       show qSub',
+                       show qSubAuth',
+                       show qSubDuplicate',
+                       show qSubProhibited',
+                       show msgSentAuth',
+                       show msgSentQuota',
+                       show msgSentLarge'
+                     ]
               )
         liftIO $ threadDelay' interval
       where
@@ -505,19 +520,25 @@ receive h@THandle {params = THandleParams {thAuth}} Client {rcvQ, sndQ, rcvActiv
   forever $ do
     ts <- L.toList <$> liftIO (tGet h)
     atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
-    (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
+    stats <- asks serverStats
+    (errs, cmds) <- partitionEithers <$> mapM (cmdAction stats) ts
     write sndQ errs
     write rcvQ cmds
   where
-    cmdAction :: SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
-    cmdAction (tAuth, authorized, (corrId, entId, cmdOrError)) =
+    cmdAction :: ServerStats -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
+    cmdAction stats (tAuth, authorized, (corrId, entId, cmdOrError)) =
       case cmdOrError of
         Left e -> pure $ Left (corrId, entId, ERR e)
-        Right cmd -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized entId cmd
+        Right cmd -> verified =<< verifyTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized entId cmd
           where
             verified = \case
-              VRVerified qr -> Right (qr, (corrId, entId, cmd))
-              VRFailed -> Left (corrId, entId, ERR AUTH)
+              VRVerified qr -> pure $ Right (qr, (corrId, entId, cmd))
+              VRFailed -> do
+                case cmd of
+                  Cmd _ SEND {} -> atomically $ modifyTVar' (msgSentAuth stats) (+ 1)
+                  Cmd _ SUB -> atomically $ modifyTVar' (qSubAuth stats) (+ 1)
+                  _ -> pure ()
+                pure $ Left (corrId, entId, ERR AUTH)
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO ()
@@ -657,40 +678,33 @@ forkClient Client {endThreads, endThreadSeq} label action = do
 client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
 client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
-  forever $ do
-    (proxied, rs) <- partitionEithers . L.toList <$> (mapM processCommand =<< atomically (readTBQueue rcvQ))
-    forM_ (L.nonEmpty rs) reply
-    forM_ (L.nonEmpty proxied) $ \cmds -> mapM forkProxiedCmd cmds >>= mapM (atomically . takeTMVar) >>= reply
+  forever $
+    atomically (readTBQueue rcvQ)
+      >>= mapM processCommand
+      >>= mapM_ reply . L.nonEmpty . catMaybes . L.toList
   where
     reply :: MonadIO m => NonEmpty (Transmission BrokerMsg) -> m ()
     reply = atomically . writeTBQueue sndQ
-    forkProxiedCmd :: Transmission (Command 'ProxiedClient) -> M (TMVar (Transmission BrokerMsg))
-    forkProxiedCmd cmd = do
-      res <- newEmptyTMVarIO
-      bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " proxy") $
-        -- commands MUST be processed under a reasonable timeout or the client would halt
-        processProxiedCmd cmd >>= atomically . putTMVar res
-      pure res
-      where
-        wait = do
-          ServerConfig {serverClientConcurrency} <- asks config
-          atomically $ do
-            used <- readTVar procThreads
-            when (used >= serverClientConcurrency) retry
-            writeTVar procThreads $! used + 1
-        signal = atomically $ modifyTVar' procThreads (\t -> t - 1)
-    processProxiedCmd :: Transmission (Command 'ProxiedClient) -> M (Transmission BrokerMsg)
-    processProxiedCmd (corrId, sessId, command) = (corrId, sessId,) <$> case command of
-      PRXY srv auth -> ifM allowProxy getRelay (pure $ ERR $ PROXY BASIC_AUTH)
+    processProxiedCmd :: Transmission (Command 'ProxiedClient) -> M (Maybe (Transmission BrokerMsg))
+    processProxiedCmd (corrId, sessId, command) = (corrId,sessId,) <$$> case command of
+      PRXY srv auth -> ifM allowProxy getRelay (pure $ Just $ ERR $ PROXY BASIC_AUTH)
         where
           allowProxy = do
             ServerConfig {allowSMPProxy, newQueueBasicAuth} <- asks config
             pure $ allowSMPProxy && maybe True ((== auth) . Just) newQueueBasicAuth
           getRelay = do
+            ProxyAgent {smpAgent = a} <- asks proxyAgent
+            liftIO (getConnectedSMPServerClient a srv) >>= \case
+              Just r -> Just <$> proxyServerResponse a r
+              Nothing ->
+                forkProxiedCmd $
+                  liftIO (runExceptT (getSMPServerClient'' a srv) `catch` (pure . Left . PCEIOError))
+                    >>= proxyServerResponse a
+          proxyServerResponse :: SMPClientAgent -> Either SMPClientError (OwnServer, SMPClient) -> M BrokerMsg
+          proxyServerResponse a smp_ = do
             ServerStats {pRelays, pRelaysOwn} <- asks serverStats
             let inc = mkIncProxyStats pRelays pRelaysOwn
-            ProxyAgent {smpAgent = a} <- asks proxyAgent
-            liftIO (runExceptT (getSMPServerClient'' a srv) `catch` (pure . Left . PCEIOError)) >>= \case
+            case smp_ of
               Right (own, smp) -> do
                 inc own pRequests
                 case proxyResp smp of
@@ -700,11 +714,12 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                 let own = isOwnServer a srv
                 inc own pRequests
                 inc own $ if temporaryClientError e then pErrorsConnect else pErrorsOther
+                logError $ "Error connecting: " <> decodeLatin1 (strEncode $ host srv) <> " " <> tshow e
                 pure . ERR $ smpProxyError e
             where
               proxyResp smp =
                 let THandleParams {sessionId = srvSessId, thVersion, thServerVRange, thAuth} = thParams smp
-                 in case compatibleVRange thServerVRange proxiedSMPRelayVRange of
+                  in case compatibleVRange thServerVRange proxiedSMPRelayVRange of
                       -- Cap the destination relay version range to prevent client version fingerprinting.
                       -- See comment for proxiedSMPRelayVersion.
                       Just (Compatible vr) | thVersion >= sendingProxySMPVersion -> case thAuth of
@@ -718,54 +733,67 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
         atomically (lookupSMPServerClient a sessId) >>= \case
           Just (own, smp) -> do
             inc own pRequests
-            if
-              | v >= sendingProxySMPVersion ->
-                  liftIO (runExceptT (forwardSMPMessage smp corrId fwdV pubKey encBlock) `catch` (pure . Left . PCEIOError))  >>= \case
-                    Right r -> PRES r <$ inc own pSuccesses
-                    Left e -> case e of
-                      PCEProtocolError {} -> ERR err <$ inc own pSuccesses
-                      _ -> ERR err <$ inc own pErrorsOther
-                      where
-                        err = smpProxyError e
-              | otherwise -> ERR (transportErr TEVersion) <$ inc own pErrorsCompat
+            if v >= sendingProxySMPVersion
+              then forkProxiedCmd $ do
+                liftIO (runExceptT (forwardSMPMessage smp corrId fwdV pubKey encBlock) `catch` (pure . Left . PCEIOError))  >>= \case
+                  Right r -> PRES r <$ inc own pSuccesses
+                  Left e -> ERR (smpProxyError e) <$ case e of
+                    PCEProtocolError {} -> inc own pSuccesses
+                    _ -> inc own pErrorsOther
+              else Just (ERR $ transportErr TEVersion) <$ inc own pErrorsCompat
             where
               THandleParams {thVersion = v} = thParams smp
-          Nothing -> inc False pRequests >> inc False pErrorsConnect $> ERR (PROXY NO_SESSION)
+          Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
+      where
+        forkProxiedCmd :: M BrokerMsg -> M (Maybe BrokerMsg)
+        forkProxiedCmd cmdAction = do
+          bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " proxy") $ do
+            -- commands MUST be processed under a reasonable timeout or the client would halt
+            cmdAction >>= \t -> reply [(corrId, sessId, t)]
+          pure Nothing
+          where
+            wait = do
+              ServerConfig {serverClientConcurrency} <- asks config
+              atomically $ do
+                used <- readTVar procThreads
+                when (used >= serverClientConcurrency) retry
+                writeTVar procThreads $! used + 1
+            signal = atomically $ modifyTVar' procThreads (\t -> t - 1)
     transportErr :: TransportError -> ErrorType
     transportErr = PROXY . BROKER . TRANSPORT
     mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> TVar Int) -> m ()
     mkIncProxyStats ps psOwn = \own sel -> do
       atomically $ modifyTVar' (sel ps) (+ 1)
       when own $ atomically $ modifyTVar' (sel psOwn) (+ 1)
-    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Either (Transmission (Command 'ProxiedClient)) (Transmission BrokerMsg))
-    processCommand (qr_, (corrId, queueId, cmd)) = do
-      st <- asks queueStore
-      case cmd of
-        Cmd SProxiedClient command -> pure $ Left (corrId, queueId, command)
-        Cmd SSender command -> Right <$> case command of
-          SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
-          PING -> pure (corrId, "", PONG)
-          RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
-        Cmd SNotifier NSUB -> Right <$> subscribeNotifications
-        Cmd SRecipient command ->
-          Right <$> case command of
-            NEW rKey dhKey auth subMode ->
-              ifM
-                allowNew
-                (createQueue st rKey dhKey subMode)
-                (pure (corrId, queueId, ERR AUTH))
-              where
-                allowNew = do
-                  ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
-                  pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
-            SUB -> withQueue (`subscribeQueue` queueId)
-            GET -> withQueue getMessage
-            ACK msgId -> withQueue (`acknowledgeMsg` msgId)
-            KEY sKey -> secureQueue_ st sKey
-            NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
-            NDEL -> deleteQueueNotifier_ st
-            OFF -> suspendQueue_ st
-            DEL -> delQueueAndMsgs st
+    processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Maybe (Transmission BrokerMsg))
+    processCommand (qr_, (corrId, queueId, cmd)) = case cmd of
+      Cmd SProxiedClient command -> processProxiedCmd (corrId, queueId, command)
+      Cmd SSender command -> Just <$> case command of
+        SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
+        PING -> pure (corrId, "", PONG)
+        RFWD encBlock -> (corrId, "",) <$> processForwardedCommand encBlock
+      Cmd SNotifier NSUB -> Just <$> subscribeNotifications
+      Cmd SRecipient command -> do
+        st <- asks queueStore
+        Just <$> case command of
+          NEW rKey dhKey auth subMode ->
+            ifM
+              allowNew
+              (createQueue st rKey dhKey subMode)
+              (pure (corrId, queueId, ERR AUTH))
+            where
+              allowNew = do
+                ServerConfig {allowNewQueues, newQueueBasicAuth} <- asks config
+                pure $ allowNewQueues && maybe True ((== auth) . Just) newQueueBasicAuth
+          SUB -> withQueue (`subscribeQueue` queueId)
+          GET -> withQueue getMessage
+          ACK msgId -> withQueue (`acknowledgeMsg` msgId)
+          KEY sKey -> secureQueue_ st sKey
+          NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
+          NDEL -> deleteQueueNotifier_ st
+          OFF -> suspendQueue_ st
+          DEL -> delQueueAndMsgs st
+          QUE -> withQueue getQueueInfo
       where
         createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> M (Transmission BrokerMsg)
         createQueue st recipientKey dhKey subMode = time "NEW" $ do
@@ -852,15 +880,19 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         subscribeQueue :: QueueRec -> RecipientId -> M (Transmission BrokerMsg)
         subscribeQueue qr rId = do
+          stats <- asks serverStats
           atomically (TM.lookup rId subscriptions) >>= \case
-            Nothing ->
+            Nothing -> do
+              atomically $ modifyTVar' (qSub stats) (+ 1)
               newSub >>= deliver
             Just sub ->
               readTVarIO sub >>= \case
-                Sub {subThread = ProhibitSub} ->
+                Sub {subThread = ProhibitSub} -> do
                   -- cannot use SUB in the same connection where GET was used
+                  atomically $ modifyTVar' (qSubProhibited stats) (+ 1)
                   pure (corrId, rId, ERR $ CMD PROHIBITED)
-                s ->
+                s -> do
+                  atomically $ modifyTVar' (qSubDuplicate stats) (+ 1)
                   atomically (tryTakeTMVar $ delivered s) >> deliver sub
           where
             newSub :: M (TVar Sub)
@@ -954,29 +986,37 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         sendMessage :: QueueRec -> MsgFlags -> MsgBody -> M (Transmission BrokerMsg)
         sendMessage qr msgFlags msgBody
-          | B.length msgBody > maxMessageLength thVersion = pure $ err LARGE_MSG
-          | otherwise = case status qr of
-              QueueOff -> return $ err AUTH
-              QueueActive ->
-                case C.maxLenBS msgBody of
-                  Left _ -> pure $ err LARGE_MSG
-                  Right body -> do
-                    msg_ <- time "SEND" $ do
-                      q <- getStoreMsgQueue "SEND" $ recipientId qr
-                      expireMessages q
-                      atomically . writeMsg q =<< mkMessage body
-                    case msg_ of
-                      Nothing -> pure $ err QUOTA
-                      Just msg -> time "SEND ok" $ do
-                        stats <- asks serverStats
-                        when (notification msgFlags) $ do
-                          atomically . trySendNotification msg =<< asks random
-                          atomically $ modifyTVar' (msgSentNtf stats) (+ 1)
-                          atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
-                        atomically $ modifyTVar' (msgSent stats) (+ 1)
-                        atomically $ modifyTVar' (msgCount stats) (+ 1)
-                        atomically $ updatePeriodStats (activeQueues stats) (recipientId qr)
-                        pure ok
+          | B.length msgBody > maxMessageLength thVersion = do
+              stats <- asks serverStats
+              atomically $ modifyTVar' (msgSentLarge stats) (+ 1)
+              pure $ err LARGE_MSG
+          | otherwise = do
+              stats <- asks serverStats
+              case status qr of
+                QueueOff -> do
+                  atomically $ modifyTVar' (msgSentAuth stats) (+ 1)
+                  pure $ err AUTH
+                QueueActive ->
+                  case C.maxLenBS msgBody of
+                    Left _ -> pure $ err LARGE_MSG
+                    Right body -> do
+                      msg_ <- time "SEND" $ do
+                        q <- getStoreMsgQueue "SEND" $ recipientId qr
+                        expireMessages q
+                        atomically . writeMsg q =<< mkMessage body
+                      case msg_ of
+                        Nothing -> do
+                          atomically $ modifyTVar' (msgSentQuota stats) (+ 1)
+                          pure $ err QUOTA
+                        Just msg -> time "SEND ok" $ do
+                          when (notification msgFlags) $ do
+                            atomically . trySendNotification msg =<< asks random
+                            atomically $ modifyTVar' (msgSentNtf stats) (+ 1)
+                            atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
+                          atomically $ modifyTVar' (msgSent stats) (+ 1)
+                          atomically $ modifyTVar' (msgCount stats) (+ 1)
+                          atomically $ updatePeriodStats (activeQueues stats) (recipientId qr)
+                          pure ok
           where
             THandleParams {thVersion} = thParams'
             mkMessage :: C.MaxLenBS MaxMessageLen -> M Message
@@ -1036,7 +1076,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
               Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
                 Cmd SSender SEND {} ->
                   -- Left will not be returned by processCommand, as only SEND command is allowed
-                  fromRight (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
+                  fromMaybe (corrId', entId', ERR INTERNAL) <$> lift (processCommand t'')
                 _ ->
                   pure (corrId', entId', ERR $ CMD PROHIBITED)
           -- encode response
@@ -1125,6 +1165,26 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
             Right q -> updateDeletedStats q $> ok
             Left e -> pure $ err e
 
+        getQueueInfo :: QueueRec -> M (Transmission BrokerMsg)
+        getQueueInfo QueueRec {senderKey, notifier} = do
+          q@MsgQueue {size} <- getStoreMsgQueue "getQueueInfo" queueId
+          info <- atomically $ do
+            qiSub <- TM.lookup queueId subscriptions >>= mapM mkQSub
+            qiSize <- readTVar size
+            qiMsg <- toMsgInfo <$$> tryPeekMsg q
+            pure QueueInfo {qiSnd = isJust senderKey, qiNtf = isJust notifier, qiSub, qiSize, qiMsg}
+          pure (corrId, queueId, INFO info)
+          where
+            mkQSub sub = do
+              Sub {subThread, delivered} <- readTVar sub
+              let qSubThread = case subThread of
+                    NoSub -> QNoSub
+                    SubPending -> QSubPending
+                    SubThread _ -> QSubThread
+                    ProhibitSub -> QProhibitSub
+              qDelivered <- decodeLatin1 . encode <$$> tryReadTMVar delivered
+              pure QSub {qSubThread, qDelivered}
+          
         ok :: Transmission BrokerMsg
         ok = (corrId, queueId, OK)
 

src/Simplex/Messaging/Server/CLI.hs

@@ -254,7 +254,7 @@ onOffPrompt prompt def =
       "N" -> pure False
       _ -> putStrLn "Invalid input, please enter 'y' or 'n'" >> onOffPrompt prompt def
 
-onOff :: Bool -> String
+onOff :: Bool -> Text
 onOff True = "on"
 onOff _ = "off"
 

src/Simplex/Messaging/Server/Env/STM.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StrictData #-}
 
 module Simplex.Messaging.Server.Env.STM where
 
@@ -15,6 +16,7 @@ import qualified Data.IntMap.Strict as IM
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Maybe (isJust, isNothing)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import Data.X509.Validation (Fingerprint (..))
@@ -27,6 +29,7 @@ import Simplex.Messaging.Crypto (KeyHash (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore (NtfCreds (..), QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
@@ -81,9 +84,12 @@ data ServerConfig = ServerConfig
     transportConfig :: TransportServerConfig,
     -- | run listener on control port
     controlPort :: Maybe ServiceName,
+    -- | SMP proxy config
     smpAgentCfg :: SMPClientAgentConfig,
     allowSMPProxy :: Bool, -- auth is the same with `newQueueBasicAuth`
-    serverClientConcurrency :: Int
+    serverClientConcurrency :: Int,
+    -- | server public information
+    information :: Maybe ServerPublicInfo
   }
 
 defMsgExpirationDays :: Int64
@@ -104,10 +110,11 @@ defaultInactiveClientExpiration =
     }
 
 defaultProxyClientConcurrency :: Int
-defaultProxyClientConcurrency = 16
+defaultProxyClientConcurrency = 32
 
 data Env = Env
   { config :: ServerConfig,
+    serverInfo :: ServerInformation,
     server :: Server,
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
@@ -192,7 +199,7 @@ newSubscription subThread = do
   return Sub {subThread, delivered}
 
 newEnv :: ServerConfig -> IO Env
-newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig} = do
+newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile, storeLogFile, smpAgentCfg, transportConfig, information, messageExpiration} = do
   server <- atomically newServer
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
@@ -206,7 +213,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
   clientSeq <- newTVarIO 0
   clients <- newTVarIO mempty
   proxyAgent <- atomically $ newSMPProxyAgent smpAgentCfg random
-  return Env {config, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
+  pure Env {config, serverInfo, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients, proxyAgent}
   where
     restoreQueues :: QueueStore -> FilePath -> IO (StoreLog 'WriteMode)
     restoreQueues QueueStore {queues, senders, notifiers} f = do
@@ -222,6 +229,23 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
     addNotifier q = case notifier q of
       Nothing -> id
       Just NtfCreds {notifierId} -> M.insert notifierId (recipientId q)
+    serverInfo =
+      ServerInformation
+        { information,
+          config =
+            ServerPublicConfig
+              { persistence,
+                messageExpiration = ttl <$> messageExpiration,
+                statsEnabled = isJust $ logStatsInterval config,
+                newQueuesAllowed = allowNewQueues config,
+                basicAuthEnabled = isJust $ newQueueBasicAuth config
+              }
+        }
+      where
+        persistence
+          | isNothing storeLogFile = SPMMemoryOnly
+          | isJust (storeMsgsFile config) = SPMMessages
+          | otherwise = SPMQueues
 
 newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do

src/Simplex/Messaging/Server/Information.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Server.Information where
+
+import qualified Data.Aeson.TH as J
+import Data.Int (Int64)
+import Data.Text (Text)
+import Simplex.Messaging.Agent.Protocol (ConnectionMode (..), ConnectionRequestUri)
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
+
+data ServerInformation = ServerInformation
+  { config :: ServerPublicConfig,
+    information :: Maybe ServerPublicInfo
+  }
+  deriving (Show)
+
+-- based on server configuration
+data ServerPublicConfig = ServerPublicConfig
+  { persistence :: ServerPersistenceMode,
+    messageExpiration :: Maybe Int64,
+    statsEnabled :: Bool,
+    newQueuesAllowed :: Bool,
+    basicAuthEnabled :: Bool -- server is private if enabled
+  }
+  deriving (Show)
+
+-- based on INFORMATION section of INI file
+data ServerPublicInfo = ServerPublicInfo
+  { sourceCode :: Text, -- note that this property is not optional, in line with AGPLv3 license
+    usageConditions :: Maybe ServerConditions,
+    operator :: Maybe Entity,
+    website :: Maybe Text,
+    adminContacts :: Maybe ServerContactAddress,
+    complaintsContacts :: Maybe ServerContactAddress,
+    hosting :: Maybe Entity,
+    serverCountry :: Maybe Text
+  }
+  deriving (Show)
+
+data ServerPersistenceMode = SPMMemoryOnly | SPMQueues | SPMMessages
+  deriving (Show)
+
+data ServerConditions = ServerConditions {conditions :: Text, amendments :: Maybe Text}
+  deriving (Show)
+
+data Entity = Entity {name :: Text, country :: Maybe Text}
+  deriving (Show)
+
+data ServerContactAddress = ServerContactAddress
+  { simplex :: Maybe (ConnectionRequestUri 'CMContact),
+    email :: Maybe Text, -- it is recommended that it matches DNS email address, if either is present
+    pgp :: Maybe PGPKey
+  }
+  deriving (Show)
+
+data PGPKey = PGPKey {pkURI :: Text, pkFingerprint :: Text}
+  deriving (Show)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "SPM") ''ServerPersistenceMode)
+
+$(J.deriveJSON defaultJSON ''ServerConditions)
+
+$(J.deriveJSON defaultJSON ''Entity)
+
+$(J.deriveJSON defaultJSON ''PGPKey)
+
+$(J.deriveJSON defaultJSON ''ServerContactAddress)
+
+$(J.deriveJSON defaultJSON ''ServerPublicConfig)
+
+$(J.deriveJSON defaultJSON ''ServerPublicInfo)
+
+$(J.deriveJSON defaultJSON ''ServerInformation)

src/Simplex/Messaging/Server/Main.hs

@@ -5,34 +5,45 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Server.Main where
 
 import Control.Concurrent.STM
-import Control.Monad (void)
+import Control.Logger.Simple
+import Control.Monad (void, when, (<$!>))
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (isAlpha, isAscii, toUpper)
 import Data.Functor (($>))
-import Data.Ini (lookupValue, readIniFile)
-import Data.Maybe (fromMaybe)
+import Data.Ini (Ini, lookupValue, readIniFile)
+import Data.List (find, isPrefixOf)
+import qualified Data.List.NonEmpty as L
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
+import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
+import Simplex.Messaging.Agent.Protocol (connReqUriP')
 import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defMsgExpirationDays, defaultInactiveClientExpiration, defaultMessageExpiration, defaultProxyClientConcurrency)
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedSMPHandshakes, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
-import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -40,7 +51,10 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
 
 smpServerCLI :: FilePath -> FilePath -> IO ()
-smpServerCLI cfgPath logPath =
+smpServerCLI = smpServerCLI_ (\_ _ _ -> pure ()) (\_ -> pure ())
+
+smpServerCLI_ :: (ServerInformation -> Maybe TransportHost -> FilePath -> IO ()) -> (EmbeddedWebParams -> IO ()) -> FilePath -> FilePath -> IO ()
+smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
   getCliCommand' (cliCommandP cfgPath logPath iniFile) serverVersion >>= \case
     Init opts ->
       doesFileExist iniFile >>= \case
@@ -65,7 +79,10 @@ smpServerCLI cfgPath logPath =
     defaultServerPort = "5223"
     executableName = "smp-server"
     storeLogFilePath = combine logPath "smp-server-store.log"
-    initializeServer opts@InitOptions {ip, fqdn, scripted}
+    httpsCertFile = combine cfgPath "web.cert"
+    httpsKeyFile = combine cfgPath "web.key"
+    defaultStaticPath = combine logPath "www"
+    initializeServer opts@InitOptions {ip, fqdn, sourceCode = src', webStaticPath = sp', disableWeb = noWeb', scripted}
       | scripted = initialize opts
       | otherwise = do
           putStrLn "Use `smp-server init -h` for available options."
@@ -76,7 +93,19 @@ smpServerCLI cfgPath logPath =
           password <- withPrompt "'r' for random (default), 'n' - no password, or enter password: " serverPassword
           let host = fromMaybe ip fqdn
           host' <- withPrompt ("Enter server FQDN or IP address for certificate (" <> host <> "): ") getLine
-          initialize opts {enableStoreLog, logStats, fqdn = if null host' then fqdn else Just host', password}
+          sourceCode' <- withPrompt ("Enter server source code URI (" <> maybe simplexmqSource T.unpack src' <> "): ") getServerSourceCode
+          staticPath' <- withPrompt ("Enter path to store generated static site with server information (" <> fromMaybe defaultStaticPath sp' <> "): ") getLine
+          enableWeb <- onOffPrompt "Enable built-in web server for static site" (not noWeb')
+          initialize
+            opts
+              { enableStoreLog,
+                logStats,
+                fqdn = if null host' then fqdn else Just host',
+                password,
+                sourceCode = (T.pack <$> sourceCode') <|> src',
+                webStaticPath = if null staticPath' then sp' else Just staticPath',
+                disableWeb = not enableWeb
+              }
       where
         serverPassword =
           getLine >>= \case
@@ -87,7 +116,7 @@ smpServerCLI cfgPath logPath =
               case strDecode $ encodeUtf8 $ T.pack s of
                 Right auth -> pure . Just $ ServerPassword auth
                 _ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword
-        initialize InitOptions {enableStoreLog, logStats, signAlgorithm, password} = do
+        initialize InitOptions {enableStoreLog, logStats, signAlgorithm, password, sourceCode, webStaticPath, disableWeb} = do
           clearDirIfExists cfgPath
           clearDirIfExists logPath
           createDirectoryIfMissing True cfgPath
@@ -97,26 +126,29 @@ smpServerCLI cfgPath logPath =
           basicAuth <- mapM createServerPassword password
           let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
               srv = ProtoServerWithAuth (SMPServer [THDomainName host] "" (C.KeyHash fp)) basicAuth
-          writeFile iniFile $ iniFileContent host basicAuth
-          putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
+          T.writeFile iniFile $ iniFileContent host basicAuth $ Just "https://github.com/simplex-chat/simplexmq"
+          putStrLn $ "Server initialized, please provide additional server information in " <> iniFile <> "."
+          putStrLn $ "Run `" <> executableName <> " start` to start server."
           warnCAPrivateKeyFile cfgPath x509cfg
           printServiceInfo serverVersion srv
+          printSourceCode sourceCode
           where
             createServerPassword = \case
               ServerPassword s -> pure s
               SPRandom -> BasicAuth . strEncode <$> (atomically . C.randomBytes 32 =<< C.newRandom)
-            iniFileContent host basicAuth =
-              "[STORE_LOG]\n\
-              \# The server uses STM memory for persistence,\n\
-              \# that will be lost on restart (e.g., as with redis).\n\
-              \# This option enables saving memory to append only log,\n\
-              \# and restoring it when the server is started.\n\
-              \# Log is compacted on start (deleted objects are removed).\n"
+            iniFileContent host basicAuth sourceCode' =
+              informationIniContent sourceCode'
+                <> "[STORE_LOG]\n\
+                   \# The server uses STM memory for persistence,\n\
+                   \# that will be lost on restart (e.g., as with redis).\n\
+                   \# This option enables saving memory to append only log,\n\
+                   \# and restoring it when the server is started.\n\
+                   \# Log is compacted on start (deleted objects are removed).\n"
                 <> ("enable: " <> onOff enableStoreLog <> "\n\n")
                 <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
                    \# they are preserved in the .bak file until the next restart.\n"
                 <> ("restore_messages: " <> onOff enableStoreLog <> "\n")
-                <> ("expire_messages_days: " <> show defMsgExpirationDays <> "\n\n")
+                <> ("expire_messages_days: " <> tshow defMsgExpirationDays <> "\n\n")
                 <> "# Log daily server statistics to CSV file\n"
                 <> ("log_stats: " <> onOff logStats <> "\n\n")
                 <> "[AUTH]\n\
@@ -129,7 +161,7 @@ smpServerCLI cfgPath logPath =
                    \# The password will not be shared with the connecting contacts, you must share it only\n\
                    \# with the users who you want to allow creating messaging queues on your server.\n"
                 <> ( case basicAuth of
-                      Just auth -> "create_password: " <> T.unpack (safeDecodeUtf8 $ strEncode auth)
+                      Just auth -> "create_password: " <> safeDecodeUtf8 (strEncode auth)
                       _ -> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')"
                    )
                 <> "\n\n\
@@ -137,8 +169,8 @@ smpServerCLI cfgPath logPath =
                    \# control_port_user_password:\n\n\
                    \[TRANSPORT]\n\
                    \# host is only used to print server address on start\n"
-                <> ("host: " <> host <> "\n")
-                <> ("port: " <> defaultServerPort <> "\n")
+                <> ("host: " <> T.pack host <> "\n")
+                <> ("port: " <> T.pack defaultServerPort <> "\n")
                 <> "log_tls_errors: off\n\
                    \websockets: off\n\
                    \# control_port: 5224\n\n\
@@ -157,21 +189,36 @@ smpServerCLI cfgPath logPath =
                    \# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
                    \# socks_mode: onion\n\n\
                    \# Limit number of threads a client can spawn to process proxy commands in parrallel.\n"
-                <> ("# client_concurrency: " <> show defaultProxyClientConcurrency <> "\n\n")
+                <> ("# client_concurrency: " <> tshow defaultProxyClientConcurrency <> "\n\n")
                 <> "[INACTIVE_CLIENTS]\n\
                    \# TTL and interval to check inactive clients\n\
                    \disconnect: off\n"
-                <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-                <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
+                <> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
+                <> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
+                <> "\n\n\
+                   \[WEB]\n\
+                   \# Set path to generate static mini-site for server information and qr codes/links\n"
+                <> ("static_path: " <> T.pack (fromMaybe defaultStaticPath webStaticPath) <> "\n\n")
+                <> "# Run an embedded server on this port\n\
+                   \# Onion sites can use any port and register it in the hidden service config.\n\
+                   \# Running on a port 80 may require setting process capabilities.\n"
+                <> ((if disableWeb then "# " else "") <> "http: 8000\n\n")
+                <> "# You can run an embedded TLS web server too if you provide port and cert and key files.\n\
+                   \# Not required for running relay on onion address.\n\
+                   \# https: 443\n"
+                <> ("# cert: " <> T.pack httpsCertFile <> "\n")
+                <> ("# key: " <> T.pack httpsKeyFile <> "\n")
     runServer ini = do
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
       let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
-          cfg@ServerConfig {transports, storeLogFile, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
+          cfg@ServerConfig {information, transports, storeLogFile, newQueueBasicAuth, messageExpiration, inactiveClientExpiration} = serverConfig
+          sourceCode' = (\ServerPublicInfo {sourceCode} -> sourceCode) <$> information
           srv = ProtoServerWithAuth (SMPServer [THDomainName host] (if port == "5223" then "" else port) (C.KeyHash fp)) newQueueBasicAuth
       printServiceInfo serverVersion srv
+      printSourceCode sourceCode'
       printServerConfig transports storeLogFile
       putStrLn $ case messageExpiration of
         Just ExpirationConfig {ttl} -> "expiring messages after " <> showTTL ttl
@@ -184,6 +231,20 @@ smpServerCLI cfgPath logPath =
           <> if allowNewQueues cfg
             then maybe "allowed" (const "requires password") newQueueBasicAuth
             else "NOT allowed"
+      -- print information
+      let persistence
+            | isNothing storeLogFile = SPMMemoryOnly
+            | isJust (storeMsgsFile cfg) = SPMMessages
+            | otherwise = SPMQueues
+      let config =
+            ServerPublicConfig
+              { persistence,
+                messageExpiration = ttl <$> messageExpiration,
+                statsEnabled = isJust logStats,
+                newQueuesAllowed = allowNewQueues cfg,
+                basicAuthEnabled = isJust newQueueBasicAuth
+              }
+      runWebServer ini ServerInformation {config, information}
       runSMPServer cfg
       where
         enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
@@ -211,9 +272,9 @@ smpServerCLI cfgPath logPath =
                       _ -> enableStoreLog $> messagesPath,
               -- allow creating new queues by default
               allowNewQueues = fromMaybe True $ iniOnOff "AUTH" "new_queues" ini,
-              newQueueBasicAuth = either error id <$> strDecodeIni "AUTH" "create_password" ini,
-              controlPortAdminAuth = either error id <$> strDecodeIni "AUTH" "control_port_admin_password" ini,
-              controlPortUserAuth = either error id <$> strDecodeIni "AUTH" "control_port_user_password" ini,
+              newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
+              controlPortAdminAuth = either error id <$!> strDecodeIni "AUTH" "control_port_admin_password" ini,
+              controlPortUserAuth = either error id <$!> strDecodeIni "AUTH" "control_port_user_password" ini,
               messageExpiration =
                 Just
                   defaultMessageExpiration
@@ -235,7 +296,7 @@ smpServerCLI cfgPath logPath =
                   { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
                     alpn = Just supportedSMPHandshakes
                   },
-              controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini,
+              controlPort = eitherToMaybe $ T.unpack <$> lookupValue "TRANSPORT" "control_port" ini,
               smpAgentCfg =
                 defaultSMPClientAgentConfig
                   { smpCfg =
@@ -244,7 +305,7 @@ smpServerCLI cfgPath logPath =
                           agreeSecret = True,
                           networkConfig =
                             defaultNetworkConfig
-                              { socksProxy = either error id <$> strDecodeIni "PROXY" "socks_proxy" ini,
+                              { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini,
                                 socksMode = either (const SMOnion) textToSocksMode $ lookupValue "PROXY" "socks_mode" ini,
                                 hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini,
                                 requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini
@@ -254,7 +315,8 @@ smpServerCLI cfgPath logPath =
                     persistErrorInterval = 30 -- seconds
                   },
               allowSMPProxy = True,
-              serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini
+              serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
+              information = serverPublicInfo ini
             }
         textToSocksMode :: Text -> SocksMode
         textToSocksMode = \case
@@ -269,6 +331,126 @@ smpServerCLI cfgPath logPath =
         textToOwnServers :: Text -> [ByteString]
         textToOwnServers = map encodeUtf8 . T.words
 
+    runWebServer ini si =
+      case eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini of
+        Nothing -> logWarn "No server static path set"
+        Just webStaticPath -> do
+          let onionHost =
+                either (const Nothing) (find isOnion) $
+                  strDecode @(L.NonEmpty TransportHost) . encodeUtf8 =<< lookupValue "TRANSPORT" "host" ini
+              webHttpPort = eitherToMaybe $ read . T.unpack <$> lookupValue "WEB" "http" ini
+              webHttpsParams =
+                eitherToMaybe $ do
+                  port <- read . T.unpack <$> lookupValue "WEB" "https" ini
+                  cert <- T.unpack <$> lookupValue "WEB" "cert" ini
+                  key <- T.unpack <$> lookupValue "WEB" "key" ini
+                  pure WebHttpsParams {port, cert, key}
+          generateSite si onionHost webStaticPath
+          when (isJust webHttpPort || isJust webHttpsParams) $
+            serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams}
+          where
+            isOnion = \case THOnionHost _ -> True; _ -> False
+
+data EmbeddedWebParams = EmbeddedWebParams
+  { webStaticPath :: FilePath,
+    webHttpPort :: Maybe Int,
+    webHttpsParams :: Maybe WebHttpsParams
+  }
+
+data WebHttpsParams = WebHttpsParams
+  { port :: Int,
+    cert :: FilePath,
+    key :: FilePath
+  }
+
+getServerSourceCode :: IO (Maybe String)
+getServerSourceCode =
+  getLine >>= \case
+    "" -> pure Nothing
+    s | "https://" `isPrefixOf` s || "http://" `isPrefixOf` s -> pure $ Just s
+    _ -> putStrLn "Invalid source code. URI should start from http:// or https://" >> getServerSourceCode
+
+simplexmqSource :: String
+simplexmqSource = "https://github.com/simplex-chat/simplexmq"
+
+informationIniContent :: Maybe Text -> Text
+informationIniContent sourceCode_ =
+  "[INFORMATION]\n\
+  \# AGPLv3 license requires that you make any source code modifications\n\
+  \# available to the end users of the server.\n\
+  \# LICENSE: https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE\n\
+  \# Include correct source code URI in case the server source code is modified in any way.\n\
+  \# If any other information fields are present, source code property also MUST be present.\n\n"
+    <> (maybe "# source_code: URI" ("source_code: " <>) sourceCode_ <> "\n\n")
+    <> "# Declaring all below information is optional, any of these fields can be omitted.\n\
+       \\n\
+       \# Server usage conditions and amendments.\n\
+       \# It is recommended to use standard conditions with any amendments in a separate document.\n\
+       \# usage_conditions: https://github.com/simplex-chat/simplex-chat/blob/stable/PRIVACY.md\n\
+       \# condition_amendments: link\n\
+       \\n\
+       \# Server location and operator.\n\
+       \# server_country: ISO-3166 2-letter code\n\
+       \# operator: entity (organization or person name)\n\
+       \# operator_country: ISO-3166 2-letter code\n\
+       \# website:\n\
+       \\n\
+       \# Administrative contacts.\n\
+       \# admin_simplex: SimpleX address\n\
+       \# admin_email:\n\
+       \# admin_pgp:\n\
+       \# admin_pgp_fingerprint:\n\
+       \\n\
+       \# Contacts for complaints and feedback.\n\
+       \# complaints_simplex: SimpleX address\n\
+       \# complaints_email:\n\
+       \# complaints_pgp:\n\
+       \# complaints_pgp_fingerprint:\n\
+       \\n\
+       \# Hosting provider.\n\
+       \# hosting: entity (organization or person name)\n\
+       \# hosting_country: ISO-3166 2-letter code\n\n"
+
+serverPublicInfo :: Ini -> Maybe ServerPublicInfo
+serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
+  where
+    serverInfo sourceCode =
+      ServerPublicInfo
+        { sourceCode,
+          usageConditions =
+            (\conditions -> ServerConditions {conditions, amendments = infoValue "condition_amendments"})
+              <$!> infoValue "usage_conditions",
+          serverCountry = countryValue "server_country",
+          operator = iniEntity "operator" "operator_country",
+          website = infoValue "website",
+          adminContacts = iniContacts "admin_simplex" "admin_email" "admin_pgp" "admin_pgp_fingerprint",
+          complaintsContacts = iniContacts "complaints_simplex" "complaints_email" "complaints_pgp" "complaints_pgp_fingerprint",
+          hosting = iniEntity "hosting" "hosting_country"
+        }
+    infoValue name = eitherToMaybe $ lookupValue "INFORMATION" name ini
+    iniEntity nameField countryField =
+      (\name -> Entity {name, country = countryValue countryField})
+        <$!> infoValue nameField
+    countryValue field =
+      (\cs -> if T.length cs == 2 && T.all (\c -> isAscii c && isAlpha c) cs then T.map toUpper cs else error $ "Use ISO3166 2-letter code for " <> T.unpack field)
+        <$!> infoValue field
+    iniContacts simplexField emailField pgpKeyUriField pgpKeyFingerprintField =
+      let simplex = either error id . parseAll (connReqUriP' Nothing) . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
+          email = infoValue emailField
+          pkURI_ = infoValue pgpKeyUriField
+          pkFingerprint_ = infoValue pgpKeyFingerprintField
+       in case (simplex, email, pkURI_, pkFingerprint_) of
+            (Nothing, Nothing, Nothing, _) -> Nothing
+            (Nothing, Nothing, _, Nothing) -> Nothing
+            (_, _, pkURI, pkFingerprint) -> Just ServerContactAddress {simplex, email, pgp = PGPKey <$> pkURI <*> pkFingerprint}
+
+printSourceCode :: Maybe Text -> IO ()
+printSourceCode = \case
+  Just sourceCode -> T.putStrLn $ "Server source code: " <> sourceCode
+  Nothing -> do
+    putStrLn "Warning: server source code is not specified."
+    putStrLn "Add 'source_code' property to [INFORMATION] section of INI file."
+
 data CliCommand
   = Init InitOptions
   | OnlineCert CertOptions
@@ -282,6 +464,9 @@ data InitOptions = InitOptions
     ip :: HostName,
     fqdn :: Maybe HostName,
     password :: Maybe ServerPassword,
+    sourceCode :: Maybe Text,
+    webStaticPath :: Maybe FilePath,
+    disableWeb :: Bool,
     scripted :: Bool
   }
   deriving (Show)
@@ -336,7 +521,6 @@ cliCommandP cfgPath logPath iniFile =
           ( long "fqdn"
               <> short 'n'
               <> help "Server FQDN used as Common Name for TLS online certificate"
-              <> showDefault
               <> metavar "FQDN"
           )
       password <-
@@ -349,12 +533,41 @@ cliCommandP cfgPath logPath iniFile =
                   <> help "Set password to create new messaging queues"
                   <> value SPRandom
               )
+      sourceCode <-
+        (optional . strOption)
+          ( long "source-code"
+              <> help "Server source code will be communicated to the users"
+              <> metavar "URI"
+          )
+      webStaticPath <-
+        (optional . strOption)
+          ( long "web-path"
+              <> help "Directory to store generated static site with server information"
+              <> metavar "PATH"
+          )
+      disableWeb <-
+        switch
+          ( long "disable-web"
+              <> help "Disable starting static web server with server information"
+          )
       scripted <-
         switch
           ( long "yes"
               <> short 'y'
               <> help "Non-interactive initialization using command-line options"
           )
-      pure InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password, scripted}
+      pure
+        InitOptions
+          { enableStoreLog,
+            logStats,
+            signAlgorithm,
+            ip,
+            fqdn,
+            password,
+            sourceCode,
+            webStaticPath,
+            disableWeb,
+            scripted
+          }
     parseBasicAuth :: ReadM ServerPassword
     parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack

src/Simplex/Messaging/Server/QueueStore/QueueInfo.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Server.QueueStore.QueueInfo where
+
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
+import Simplex.Messaging.Util ((<$?>))
+
+data QueueInfo = QueueInfo
+  { qiSnd :: Bool,
+    qiNtf :: Bool,
+    qiSub :: Maybe QSub,
+    qiSize :: Int,
+    qiMsg :: Maybe MsgInfo
+  }
+  deriving (Eq, Show)
+
+data QSub = QSub
+  { qSubThread :: QSubThread,
+    qDelivered :: Maybe Text
+  }
+  deriving (Eq, Show)
+
+data QSubThread = QNoSub | QSubPending | QSubThread | QProhibitSub
+  deriving (Eq, Show)
+
+data MsgInfo = MsgInfo
+  { msgId :: Text,
+    msgTs :: UTCTime,
+    msgType :: MsgType
+  }
+  deriving (Eq, Show)
+
+data MsgType = MTMessage | MTQuota
+  deriving (Eq, Show)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "Q") ''QSubThread)
+
+$(JQ.deriveJSON defaultJSON ''QSub)
+
+$(JQ.deriveJSON (enumJSON $ dropPrefix "MT") ''MsgType)
+
+$(JQ.deriveJSON defaultJSON ''MsgInfo)
+
+$(JQ.deriveJSON defaultJSON ''QueueInfo)
+
+instance Encoding QueueInfo where
+  smpEncode = LB.toStrict . J.encode
+  smpP = J.eitherDecodeStrict <$?> A.takeByteString

src/Simplex/Messaging/Server/Stats.hs

@@ -26,7 +26,14 @@ data ServerStats = ServerStats
     qDeletedAll :: TVar Int,
     qDeletedNew :: TVar Int,
     qDeletedSecured :: TVar Int,
+    qSub :: TVar Int,
+    qSubAuth :: TVar Int,
+    qSubDuplicate :: TVar Int,
+    qSubProhibited :: TVar Int,
     msgSent :: TVar Int,
+    msgSentAuth :: TVar Int,
+    msgSentQuota :: TVar Int,
+    msgSentLarge :: TVar Int,
     msgRecv :: TVar Int,
     msgExpired :: TVar Int,
     activeQueues :: PeriodStats RecipientId,
@@ -49,7 +56,14 @@ data ServerStatsData = ServerStatsData
     _qDeletedAll :: Int,
     _qDeletedNew :: Int,
     _qDeletedSecured :: Int,
+    _qSub :: Int,
+    _qSubAuth :: Int,
+    _qSubDuplicate :: Int,
+    _qSubProhibited :: Int,
     _msgSent :: Int,
+    _msgSentAuth :: Int,
+    _msgSentQuota :: Int,
+    _msgSentLarge :: Int,
     _msgRecv :: Int,
     _msgExpired :: Int,
     _activeQueues :: PeriodStatsData RecipientId,
@@ -74,7 +88,14 @@ newServerStats ts = do
   qDeletedAll <- newTVar 0
   qDeletedNew <- newTVar 0
   qDeletedSecured <- newTVar 0
+  qSub <- newTVar 0
+  qSubAuth <- newTVar 0
+  qSubDuplicate <- newTVar 0
+  qSubProhibited <- newTVar 0
   msgSent <- newTVar 0
+  msgSentAuth <- newTVar 0
+  msgSentQuota <- newTVar 0
+  msgSentLarge <- newTVar 0
   msgRecv <- newTVar 0
   msgExpired <- newTVar 0
   activeQueues <- newPeriodStats
@@ -88,7 +109,7 @@ newServerStats ts = do
   pMsgFwdsRecv <- newTVar 0
   qCount <- newTVar 0
   msgCount <- newTVar 0
-  pure ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, msgSent, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv, qCount, msgCount}
+  pure ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedNew, qDeletedSecured, qSub, qSubAuth, qSubDuplicate, qSubProhibited, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv, qCount, msgCount}
 
 getServerStatsData :: ServerStats -> STM ServerStatsData
 getServerStatsData s = do
@@ -98,7 +119,14 @@ getServerStatsData s = do
   _qDeletedAll <- readTVar $ qDeletedAll s
   _qDeletedNew <- readTVar $ qDeletedNew s
   _qDeletedSecured <- readTVar $ qDeletedSecured s
+  _qSub <- readTVar $ qSub s
+  _qSubAuth <- readTVar $ qSubAuth s
+  _qSubDuplicate <- readTVar $ qSubDuplicate s  
+  _qSubProhibited <- readTVar $ qSubProhibited s
   _msgSent <- readTVar $ msgSent s
+  _msgSentAuth <- readTVar $ msgSentAuth s
+  _msgSentQuota <- readTVar $ msgSentQuota s
+  _msgSentLarge <- readTVar $ msgSentLarge s
   _msgRecv <- readTVar $ msgRecv s
   _msgExpired <- readTVar $ msgExpired s
   _activeQueues <- getPeriodStatsData $ activeQueues s
@@ -112,7 +140,7 @@ getServerStatsData s = do
   _pMsgFwdsRecv <- readTVar $ pMsgFwdsRecv s
   _qCount <- readTVar $ qCount s
   _msgCount <- readTVar $ msgCount s
-  pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeletedAll, _qDeletedNew, _qDeletedSecured, _msgSent, _msgRecv, _msgExpired, _activeQueues, _msgSentNtf, _msgRecvNtf, _activeQueuesNtf, _pRelays, _pRelaysOwn, _pMsgFwds, _pMsgFwdsOwn, _pMsgFwdsRecv, _qCount, _msgCount}
+  pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeletedAll, _qDeletedNew, _qDeletedSecured, _qSub, _qSubAuth, _qSubDuplicate, _qSubProhibited, _msgSent, _msgSentAuth, _msgSentQuota, _msgSentLarge, _msgRecv, _msgExpired, _activeQueues, _msgSentNtf, _msgRecvNtf, _activeQueuesNtf, _pRelays, _pRelaysOwn, _pMsgFwds, _pMsgFwdsOwn, _pMsgFwdsRecv, _qCount, _msgCount}
 
 setServerStats :: ServerStats -> ServerStatsData -> STM ()
 setServerStats s d = do
@@ -122,7 +150,14 @@ setServerStats s d = do
   writeTVar (qDeletedAll s) $! _qDeletedAll d
   writeTVar (qDeletedNew s) $! _qDeletedNew d
   writeTVar (qDeletedSecured s) $! _qDeletedSecured d
+  writeTVar (qSub s) $! _qSub d
+  writeTVar (qSubAuth s) $! _qSubAuth d  
+  writeTVar (qSubDuplicate s) $! _qSubDuplicate d
+  writeTVar (qSubProhibited s) $! _qSubProhibited d
   writeTVar (msgSent s) $! _msgSent d
+  writeTVar (msgSentAuth s) $! _msgSentAuth d
+  writeTVar (msgSentQuota s) $! _msgSentQuota d
+  writeTVar (msgSentLarge s) $! _msgSentLarge d
   writeTVar (msgRecv s) $! _msgRecv d
   writeTVar (msgExpired s) $! _msgExpired d
   setPeriodStats (activeQueues s) (_activeQueues d)
@@ -147,7 +182,14 @@ instance StrEncoding ServerStatsData where
         "qDeletedNew=" <> strEncode (_qDeletedNew d),
         "qDeletedSecured=" <> strEncode (_qDeletedSecured d),
         "qCount=" <> strEncode (_qCount d),
+        "qSub=" <> strEncode (_qSub d),
+        "qSubAuth=" <> strEncode (_qSubAuth d),
+        "qSubDuplicate=" <> strEncode (_qSubDuplicate d),
+        "qSubProhibited=" <> strEncode (_qSubProhibited d),
         "msgSent=" <> strEncode (_msgSent d),
+        "msgSentAuth=" <> strEncode (_msgSentAuth d),
+        "msgSentQuota=" <> strEncode (_msgSentQuota d),
+        "msgSentLarge=" <> strEncode (_msgSentLarge d),
         "msgRecv=" <> strEncode (_msgRecv d),
         "msgExpired=" <> strEncode (_msgExpired d),
         "msgSentNtf=" <> strEncode (_msgSentNtf d),
@@ -173,12 +215,19 @@ instance StrEncoding ServerStatsData where
     (_qDeletedAll, _qDeletedNew, _qDeletedSecured) <-
       (,0,0) <$> ("qDeleted=" *> strP <* A.endOfLine)
         <|> ((,,) <$> ("qDeletedAll=" *> strP <* A.endOfLine) <*> ("qDeletedNew=" *> strP <* A.endOfLine) <*> ("qDeletedSecured=" *> strP <* A.endOfLine))
-    _qCount <- "qCount=" *> strP <* A.endOfLine <|> pure 0
+    _qCount <- opt "qCount="
+    _qSub <- opt "qSub="
+    _qSubAuth <- opt "qSubAuth="
+    _qSubDuplicate <- opt "qSubDuplicate="
+    _qSubProhibited <- opt "qSubProhibited="
     _msgSent <- "msgSent=" *> strP <* A.endOfLine
+    _msgSentAuth <- opt "msgSentAuth="
+    _msgSentQuota <- opt "msgSentQuota="
+    _msgSentLarge <- opt "msgSentLarge="
     _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
-    _msgExpired <- "msgExpired=" *> strP <* A.endOfLine <|> pure 0
-    _msgSentNtf <- "msgSentNtf=" *> strP <* A.endOfLine <|> pure 0
-    _msgRecvNtf <- "msgRecvNtf=" *> strP <* A.endOfLine <|> pure 0
+    _msgExpired <- opt "msgExpired="
+    _msgSentNtf <- opt "msgSentNtf="
+    _msgRecvNtf <- opt "msgRecvNtf="
     _activeQueues <-
       optional ("activeQueues:" <* A.endOfLine) >>= \case
         Just _ -> strP <* optional A.endOfLine
@@ -195,9 +244,10 @@ instance StrEncoding ServerStatsData where
     _pRelaysOwn <- proxyStatsP "pRelaysOwn:"
     _pMsgFwds <- proxyStatsP "pMsgFwds:"
     _pMsgFwdsOwn <- proxyStatsP "pMsgFwdsOwn:"
-    _pMsgFwdsRecv <- "pMsgFwdsRecv=" *> strP <* A.endOfLine <|> pure 0
-    pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeletedAll, _qDeletedNew, _qDeletedSecured, _msgSent, _msgRecv, _msgExpired, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf, _pRelays, _pRelaysOwn, _pMsgFwds, _pMsgFwdsOwn, _pMsgFwdsRecv, _qCount, _msgCount = 0}
+    _pMsgFwdsRecv <- opt "pMsgFwdsRecv="
+    pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeletedAll, _qDeletedNew, _qDeletedSecured, _qSub, _qSubAuth, _qSubDuplicate, _qSubProhibited, _msgSent, _msgSentAuth, _msgSentQuota, _msgSentLarge, _msgRecv, _msgExpired, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf, _pRelays, _pRelaysOwn, _pMsgFwds, _pMsgFwdsOwn, _pMsgFwdsRecv, _qCount, _msgCount = 0}
     where
+      opt s = A.string s *> strP <* A.endOfLine <|> pure 0
       proxyStatsP key =
         optional (A.string key >> A.endOfLine) >>= \case
           Just _ -> strP <* optional A.endOfLine

src/Simplex/Messaging/Session.hs

@@ -8,23 +8,25 @@ import Control.Concurrent.STM
 import Control.Monad
 import Data.Composition ((.:.))
 import Data.Functor (($>))
+import Data.Time (UTCTime)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (($>>=))
 
 data SessionVar a = SessionVar
   { sessionVar :: TMVar a,
-    sessionVarId :: Int
+    sessionVarId :: Int,
+    sessionVarTs :: UTCTime
   }
 
-getSessVar :: forall k a. Ord k => TVar Int -> k -> TMap k (SessionVar a) -> STM (Either (SessionVar a) (SessionVar a))
-getSessVar sessSeq sessKey vs = maybe (Left <$> newSessionVar) (pure . Right) =<< TM.lookup sessKey vs
+getSessVar :: forall k a. Ord k => TVar Int -> k -> TMap k (SessionVar a) -> UTCTime -> STM (Either (SessionVar a) (SessionVar a))
+getSessVar sessSeq sessKey vs sessionVarTs = maybe (Left <$> newSessionVar) (pure . Right) =<< TM.lookup sessKey vs
   where
     newSessionVar :: STM (SessionVar a)
     newSessionVar = do
       sessionVar <- newEmptyTMVar
       sessionVarId <- stateTVar sessSeq $ \next -> (next, next + 1)
-      let v = SessionVar {sessionVar, sessionVarId}
+      let v = SessionVar {sessionVar, sessionVarId, sessionVarTs}
       TM.insert sessKey v vs
       pure v
 

src/Simplex/Messaging/Transport/HTTP2/Client.hs

@@ -14,6 +14,7 @@ import Control.Monad
 import Data.ByteString.Char8 (ByteString)
 import Data.Functor (($>))
 import Data.Time (UTCTime, getCurrentTime)
+import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import Network.HPACK (BufferSize)
 import Network.HTTP2.Client (ClientConfig (..), Request, Response)
@@ -29,7 +30,6 @@ import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Util (eitherToMaybe)
 import UnliftIO.STM
 import UnliftIO.Timeout
-import qualified Data.X509 as X
 
 data HTTP2Client = HTTP2Client
   { action :: Maybe (Async HTTP2Response),

src/Simplex/Messaging/Transport/HTTP2/File.hs

@@ -23,7 +23,7 @@ hReceiveFile getBody h size = get $ fromIntegral size
       if
         | chSize > sz -> pure (chSize - sz)
         | chSize > 0 -> B.hPut h ch >> get (sz - chSize)
-        | otherwise -> pure (-fromIntegral sz)
+        | otherwise -> pure (-sz)
 
 hSendFile :: Handle -> (Builder -> IO ()) -> Word32 -> IO ()
 hSendFile h send = go

src/Simplex/Messaging/Transport/Server.hs

@@ -19,7 +19,7 @@ module Simplex.Messaging.Transport.Server
     loadTLSServerParams,
     loadFingerprint,
     smpServerHandshake,
-    tlsServerCredentials
+    tlsServerCredentials,
   )
 where
 
@@ -35,11 +35,14 @@ import Data.Maybe (fromJust, fromMaybe)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..))
 import qualified Data.X509.Validation as XV
+import Foreign.C.Error
+import GHC.IO.Exception (ioe_errno)
 import Network.Socket
 import qualified Network.TLS as T
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (catchAll_, labelMyThread, tshow)
 import System.Exit (exitFailure)
+import System.IO.Error (tryIOError)
 import System.Mem.Weak (Weak, deRefWeak)
 import UnliftIO (timeout)
 import UnliftIO.Concurrent
@@ -113,15 +116,36 @@ runTCPServer started port server = do
 runTCPServerSocket :: SocketState -> TMVar Bool -> IO Socket -> (Socket -> IO ()) -> IO ()
 runTCPServerSocket (accepted, gracefullyClosed, clients) started getSocket server =
   E.bracket getSocket (closeServer started clients) $ \sock ->
-    forever . E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> do
+    forever . E.bracketOnError (safeAccept sock) (close . fst) $ \(conn, _peer) -> do
       cId <- atomically $ stateTVar accepted $ \cId -> let cId' = cId + 1 in cId `seq` (cId', cId')
       let closeConn _ = do
             atomically $ modifyTVar' clients $ IM.delete cId
             gracefulClose conn 5000 `catchAll_` pure () -- catchAll_ is needed here in case the connection was closed earlier
-            atomically $ modifyTVar' gracefullyClosed (+1)
+            atomically $ modifyTVar' gracefullyClosed (+ 1)
       tId <- mkWeakThreadId =<< server conn `forkFinally` closeConn
       atomically $ modifyTVar' clients $ IM.insert cId tId
 
+-- | Recover from errors in `accept` whenever it is safe.
+-- Some errors are safe to ignore, while blindly restaring `accept` may trigger a busy loop.
+--
+-- man accept says:
+-- @
+-- For  reliable  operation the application should detect the network errors defined for the protocol after accept() and treat them like EAGAIN by retrying.
+-- In  the  case  of  TCP/IP, these are ENETDOWN, EPROTO, ENOPROTOOPT, EHOSTDOWN, ENONET, EHOSTUNREACH, EOPNOTSUPP, and ENETUNREACH.
+-- @
+safeAccept :: Socket -> IO (Socket, SockAddr)
+safeAccept sock =
+  tryIOError (accept sock) >>= \case
+    Right r -> pure r
+    Left e
+      | retryAccept -> logWarn err >> safeAccept sock
+      | otherwise -> logError err >> E.throwIO e
+      where
+        retryAccept = maybe False ((`elem` again) . Errno) errno
+        again = [eAGAIN, eNETDOWN, ePROTO, eNOPROTOOPT, eHOSTDOWN, eNONET, eHOSTUNREACH, eOPNOTSUPP, eNETUNREACH]
+        err = "socket accept error: " <> tshow e <> maybe "" ((", errno=" <>) . tshow) errno
+        errno = ioe_errno e
+
 type SocketState = (TVar Int, TVar Int, TVar (IntMap (Weak ThreadId)))
 
 newSocketState :: STM SocketState

src/Simplex/Messaging/Util.hs

@@ -97,15 +97,15 @@ catchAll_ :: IO a -> IO a -> IO a
 catchAll_ a = catchAll a . const
 {-# INLINE catchAll_ #-}
 
-tryAllErrors :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> m (Either e a)
-tryAllErrors err action = tryError action `UE.catch` (pure . Left . err)
+tryAllErrors :: MonadUnliftIO m => (E.SomeException -> e) -> ExceptT e m a -> ExceptT e m (Either e a)
+tryAllErrors err action = ExceptT $ Right <$> runExceptT action `UE.catch` (pure . Left . err)
 {-# INLINE tryAllErrors #-}
 
 tryAllErrors' :: MonadUnliftIO m => (E.SomeException -> e) -> ExceptT e m a -> m (Either e a)
 tryAllErrors' err action = runExceptT action `UE.catch` (pure . Left . err)
 {-# INLINE tryAllErrors' #-}
 
-catchAllErrors :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> (e -> m a) -> m a
+catchAllErrors :: MonadUnliftIO m => (E.SomeException -> e) -> ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
 catchAllErrors err action handler = tryAllErrors err action >>= either handler pure
 {-# INLINE catchAllErrors #-}
 
@@ -113,11 +113,11 @@ catchAllErrors' :: MonadUnliftIO m => (E.SomeException -> e) -> ExceptT e m a ->
 catchAllErrors' err action handler = tryAllErrors' err action >>= either handler pure
 {-# INLINE catchAllErrors' #-}
 
-catchThrow :: (MonadUnliftIO m, MonadError e m) => m a -> (E.SomeException -> e) -> m a
+catchThrow :: MonadUnliftIO m => ExceptT e m a -> (E.SomeException -> e) -> ExceptT e m a
 catchThrow action err = catchAllErrors err action throwError
 {-# INLINE catchThrow #-}
 
-allFinally :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> m b -> m a
+allFinally :: MonadUnliftIO m => (E.SomeException -> e) -> ExceptT e m a -> ExceptT e m b -> ExceptT e m a
 allFinally err action final = tryAllErrors err action >>= \r -> final >> either throwError pure r
 {-# INLINE allFinally #-}
 

src/Simplex/RemoteControl/Invitation.hs

@@ -123,7 +123,7 @@ instance StrEncoding RCSignedInvitation where
     idsig <- requiredP sigs "idsig" $ parseAll strP
     pure RCSignedInvitation {invitation, ssig, idsig}
 
-signInvitation :: C.PrivateKey C.Ed25519 -> C.PrivateKey C.Ed25519 -> RCInvitation -> RCSignedInvitation
+signInvitation :: C.PrivateKey 'C.Ed25519 -> C.PrivateKey 'C.Ed25519 -> RCInvitation -> RCSignedInvitation
 signInvitation sKey idKey invitation = RCSignedInvitation {invitation, ssig, idsig}
   where
     uri = strEncode invitation

tests/AgentTests.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 
 module AgentTests (agentTests) where
 
@@ -95,23 +94,24 @@ type AEntityTransmission p e = (ACorrId, ConnId, ACommand p e)
 type AEntityTransmissionOrError p e = (ACorrId, ConnId, Either AgentErrorType (ACommand p e))
 
 tGetAgent :: Transport c => c -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
-tGetAgent = tGetAgent'
+tGetAgent = tGetAgent' True
 
-tGetAgent' :: forall c e. (Transport c, AEntityI e) => c -> IO (AEntityTransmissionOrError 'Agent e)
-tGetAgent' h = do
-  (corrId, connId, cmdOrErr) <- pGetAgent h
+tGetAgent' :: forall c e. (Transport c, AEntityI e) => Bool -> c -> IO (AEntityTransmissionOrError 'Agent e)
+tGetAgent' skipErr h = do
+  (corrId, connId, cmdOrErr) <- pGetAgent skipErr h
   case cmdOrErr of
     Right (APC e cmd) -> case testEquality e (sAEntity @e) of
       Just Refl -> pure (corrId, connId, Right cmd)
       _ -> error $ "unexpected command " <> show cmd
     Left err -> pure (corrId, connId, Left err)
 
-pGetAgent :: forall c. Transport c => c -> IO (ATransmissionOrError 'Agent)
-pGetAgent h = do
+pGetAgent :: forall c. Transport c => Bool -> c -> IO (ATransmissionOrError 'Agent)
+pGetAgent skipErr h = do
   (corrId, connId, cmdOrErr) <- tGet SAgent h
   case cmdOrErr of
-    Right (APC _ CONNECT {}) -> pGetAgent h
-    Right (APC _ DISCONNECT {}) -> pGetAgent h
+    Right (APC _ CONNECT {}) -> pGetAgent skipErr h
+    Right (APC _ DISCONNECT {}) -> pGetAgent skipErr h
+    Right (APC _ (ERR (BROKER _ NETWORK))) | skipErr -> pGetAgent skipErr h
     cmd -> pure (corrId, connId, cmd)
 
 -- | receive message to handle `h`
@@ -119,15 +119,18 @@ pGetAgent h = do
 (<#:) = tGetAgent
 
 (<#:?) :: Transport c => c -> IO (ATransmissionOrError 'Agent)
-(<#:?) = pGetAgent
+(<#:?) = pGetAgent True
 
 (<#:.) :: Transport c => c -> IO (AEntityTransmissionOrError 'Agent 'AENone)
-(<#:.) = tGetAgent'
+(<#:.) = tGetAgent' True
 
 -- | send transmission `t` to handle `h` and get response
 (#:) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
 h #: t = tPutRaw h t >> (<#:) h
 
+(#:!) :: Transport c => c -> (ByteString, ByteString, ByteString) -> IO (AEntityTransmissionOrError 'Agent 'AEConn)
+h #:! t = tPutRaw h t >> tGetAgent' False h
+
 -- | action and expected response
 -- `h #:t #> r` is the test that sends `t` to `h` and validates that the response is `r`
 (#>) :: IO (AEntityTransmissionOrError 'Agent 'AEConn) -> AEntityTransmission 'Agent 'AEConn -> Expectation
@@ -354,7 +357,7 @@ testRejectContactRequest _ alice bob = do
   -- RJCT must use correct contact connection
   alice #: ("2a", "bob", "RJCT " <> aInvId) #> ("2a", "bob", ERR $ CONN NOT_FOUND)
   alice #: ("2b", "a_contact", "RJCT " <> aInvId) #> ("2b", "a_contact", OK)
-  alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") #> ("3", "bob", ERR $ A.CMD PROHIBITED)
+  alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") =#> \case ("3", "bob", ERR (A.CMD PROHIBITED _)) -> True; _ -> False
   bob #:# "nothing should be delivered to bob"
 
 testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
@@ -426,8 +429,8 @@ testServerConnectionAfterError t _ = do
 
   withAgent1 $ \bob -> do
     withAgent2 $ \alice -> do
-      bob #: ("1", "alice", "SUB") =#> \("1", "alice", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT
-      alice #: ("1", "bob", "SUB") =#> \("1", "bob", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT
+      bob #:! ("1", "alice", "SUB") =#> \case ("1", "alice", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT; _ -> False
+      alice #:! ("1", "bob", "SUB") =#> \case ("1", "bob", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT; _ -> False
       withServer $ do
         alice <#=? \case ("", "bob", APC SAEConn (SENT 4)) -> True; ("", "", APC _ (UP s ["bob"])) -> s == server; _ -> False
         alice <#=? \case ("", "bob", APC SAEConn (SENT 4)) -> True; ("", "", APC _ (UP s ["bob"])) -> s == server; _ -> False
@@ -520,6 +523,7 @@ testMsgDeliveryQuotaExceeded _ alice bob = do
     (_, "bob", Right (MID mId)) <- alice #: (corrId, "bob", "SEND F :" <> msg)
     alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
   (_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND F :over quota")
+  alice <#= \case ("", "bob", MWARN _ (SMP _ QUOTA)) -> True; _ -> False
 
   alice #: ("1", "bob2", "SEND F :hello") #> ("1", "bob2", MID 4)
   -- if delivery is blocked it won't go further
@@ -534,6 +538,7 @@ testResumeDeliveryQuotaExceeded _ alice bob = do
     (_, "bob", Right (MID mId)) <- alice #: (corrId, "bob", "SEND F :" <> msg)
     alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
   ("5", "bob", Right (MID 8)) <- alice #: ("5", "bob", "SEND F :over quota")
+  alice <#= \case ("", "bob", MWARN 8 (SMP _ QUOTA)) -> True; _ -> False
   alice #:# "the last message not sent yet"
   bob <#= \case ("", "alice", Msg "message 1") -> True; _ -> False
   bob #: ("1", "alice", "ACK 4") #> ("1", "alice", OK)
@@ -609,12 +614,12 @@ sampleDhKey = "MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
 
 syntaxTests :: forall c. Transport c => TProxy c -> Spec
 syntaxTests t = do
-  it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX")
+  it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX parseCommand")
   describe "NEW" $ do
     describe "valid" $ do
       it "with correct parameter" $ ("211", "", "NEW T INV subscribe") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
     describe "invalid" $ do
-      it "with incorrect parameter" $ ("222", "", "NEW T hi subscribe") >#> ("222", "", "ERR CMD SYNTAX")
+      it "with incorrect parameter" $ ("222", "", "NEW T hi subscribe") >#> ("222", "", "ERR CMD SYNTAX parseCommand")
 
   describe "JOIN" $ do
     describe "valid" $ do
@@ -632,7 +637,7 @@ syntaxTests t = do
         )
           >#> ("311", "a", "ERR SMP smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001 AUTH")
     describe "invalid" $ do
-      it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")
+      it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX parseCommand")
   where
     -- simple test for one command with the expected response
     (>#>) :: ARawTransmission -> ARawTransmission -> Expectation

tests/AgentTests/EqInstances.hs

@@ -6,6 +6,7 @@ module AgentTests.EqInstances where
 
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Client (ProxiedRelay (..))
 
 instance Eq SomeConn where
   SomeConn d c == SomeConn d' c' = case testEquality d d' of
@@ -23,3 +24,7 @@ deriving instance Eq (StoredSndQueue q)
 deriving instance Eq (DBQueueId q)
 
 deriving instance Eq ClientNtfCreds
+
+deriving instance Show ProxiedRelay
+
+deriving instance Eq ProxiedRelay

tests/AgentTests/FunctionalAPITests.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
@@ -12,7 +14,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 
 module AgentTests.FunctionalAPITests
   ( functionalAPITests,
@@ -55,6 +56,8 @@ import Control.Concurrent (forkIO, killThread, threadDelay)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight)
@@ -64,9 +67,10 @@ import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map as M
 import Data.Maybe (isJust, isNothing)
 import qualified Data.Set as S
+import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
-import Data.Type.Equality
+import Data.Type.Equality (testEquality, (:~:) (Refl))
 import Data.Word (Word16)
 import qualified Database.SQLite.Simple as SQL
 import GHC.Stack (withFrozenCallStack)
@@ -90,6 +94,7 @@ import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody, ProtocolS
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
+import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, supportedSMPHandshakes)
 import Simplex.Messaging.Util (diffToMicroseconds)
 import Simplex.Messaging.Version (VersionRange (..))
@@ -105,8 +110,11 @@ type AEntityTransmission e = (ACorrId, ConnId, ACommand 'Agent e)
 
 -- deriving instance Eq (ValidFileDescription p)
 
+shouldRespond :: (HasCallStack, MonadUnliftIO m, Eq a, Show a) => m a -> a -> m ()
+a `shouldRespond` r = withFrozenCallStack $ withTimeout a (`shouldBe` r)
+
 (##>) :: (HasCallStack, MonadUnliftIO m) => m (AEntityTransmission e) -> AEntityTransmission e -> m ()
-a ##> t = withTimeout a (`shouldBe` t)
+a ##> t = a `shouldRespond` t
 
 (=##>) :: (Show a, HasCallStack, MonadUnliftIO m) => m a -> (HasCallStack => a -> Bool) -> m ()
 a =##> p =
@@ -145,6 +153,8 @@ pGet c = do
   case cmd of
     CONNECT {} -> pGet c
     DISCONNECT {} -> pGet c
+    ERR (BROKER _ NETWORK) -> pGet c
+    MWARN {} -> pGet c
     _ -> pure t
 
 pattern CONF :: ConfirmationId -> [SMPServer] -> ConnInfo -> ACommand 'Agent e
@@ -224,7 +234,7 @@ mkVersionRange :: Word16 -> Word16 -> VersionRange v
 mkVersionRange v1 v2 = V.mkVersionRange (Version v1) (Version v2)
 
 runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation
-runRight_ action = runExceptT action `shouldReturn` Right ()
+runRight_ action = withFrozenCallStack $ runExceptT action `shouldReturn` Right ()
 
 runRight :: (Show e, HasCallStack) => ExceptT e IO a -> IO a
 runRight action =
@@ -235,10 +245,10 @@ runRight action =
 getInAnyOrder :: HasCallStack => AgentClient -> [ATransmission 'Agent -> Bool] -> Expectation
 getInAnyOrder c ts = withFrozenCallStack $ inAnyOrder (pGet c) ts
 
-inAnyOrder :: (Show a, MonadIO m, HasCallStack) => m a -> [a -> Bool] -> m ()
+inAnyOrder :: (Show a, MonadUnliftIO m, HasCallStack) => m a -> [a -> Bool] -> m ()
 inAnyOrder _ [] = pure ()
 inAnyOrder g rs = withFrozenCallStack $ do
-  r <- g
+  r <- 5000000 `timeout` g >>= maybe (error "inAnyOrder timeout") pure
   let rest = filter (not . expected r) rs
   if length rest < length rs
     then inAnyOrder g rest
@@ -440,6 +450,9 @@ functionalAPITests t = do
     it "should wait for user network" testWaitForUserNetwork
     it "should not reset online to offline if happens too quickly" testDoNotResetOnlineToOffline
     it "should resume multiple threads" testResumeMultipleThreads
+  describe "SMP queue info" $ do
+    it "server should respond with queue and subscription information" $
+      withSmpServer t testServerQueueInfo
 
 testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> IO Int
 testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
@@ -571,13 +584,13 @@ testEnablePQEncryption =
     -- switched to smaller envelopes (before reporting PQ encryption enabled)
     sml <- largeMsg g PQSupportOn
     -- fail because of message size
-    Left (A.CMD LARGE) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
+    Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
     (9, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
     get ca =##> \case ("", connId, SENT 9) -> connId == bId; _ -> False
     get cb =##> \case ("", connId, MsgErr' 8 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
     ackMessage cb aId 8 Nothing
     -- -- fail in reply to sync IDss
-    Left (A.CMD LARGE) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
+    Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
     (10, PQEncOff) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
     get cb =##> \case ("", connId, SENT 10) -> connId == aId; _ -> False
     get ca =##> \case ("", connId, MsgErr' 10 MsgSkipped {} PQEncOff msg') -> connId == bId && msg' == sml; _ -> False
@@ -604,8 +617,8 @@ testEnablePQEncryption =
     (b, 26, sml) \#>\ a
     (a, 27, sml) \#>\ b
     -- PQ encryption is now disabled, but support remained enabled, so we still cannot send larger messages
-    Left (A.CMD LARGE) <- tryError $ A.sendMessage ca bId PQEncOff SMP.noMsgFlags (sml <> "123456")
-    Left (A.CMD LARGE) <- tryError $ A.sendMessage cb aId PQEncOff SMP.noMsgFlags (sml <> "123456")
+    Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOff SMP.noMsgFlags (sml <> "123456")
+    Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOff SMP.noMsgFlags (sml <> "123456")
     pure ()
   where
     (\#>\) = PQEncOff `sndRcv` PQEncOff
@@ -1263,15 +1276,10 @@ testRatchetSyncServerOffline t = withAgentClients2 $ \alice bob -> do
   liftIO $ ratchetSyncState `shouldBe` RSStarted
 
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    concurrently_
+      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
+      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
     runRight_ $ do
-      liftIO . getInAnyOrder alice $
-        [ ratchetSyncP' bobId RSAgreed,
-          serverUpP
-        ]
-      liftIO . getInAnyOrder bob2 $
-        [ ratchetSyncP' aliceId RSAgreed,
-          serverUpP
-        ]
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
       exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
@@ -1325,15 +1333,10 @@ testRatchetSyncSuspendForeground t = do
   foregroundAgent bob2
 
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    concurrently_
+      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
+      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
     runRight_ $ do
-      liftIO . getInAnyOrder alice $
-        [ ratchetSyncP' bobId RSAgreed,
-          serverUpP
-        ]
-      liftIO . getInAnyOrder bob2 $
-        [ ratchetSyncP' aliceId RSAgreed,
-          serverUpP
-        ]
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
       exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
@@ -1358,15 +1361,10 @@ testRatchetSyncSimultaneous t = do
   liftIO $ aRSS `shouldBe` RSStarted
 
   withSmpServerStoreMsgLogOn t testPort $ \_ -> do
+    concurrently_
+      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
+      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
     runRight_ $ do
-      liftIO . getInAnyOrder alice $
-        [ ratchetSyncP' bobId RSAgreed,
-          serverUpP
-        ]
-      liftIO . getInAnyOrder bob2 $
-        [ ratchetSyncP' aliceId RSAgreed,
-          serverUpP
-        ]
       get alice =##> ratchetSyncP bobId RSOk
       get bob2 =##> ratchetSyncP aliceId RSOk
       exchangeGreetingsMsgIds alice bobId 12 bob2 aliceId 9
@@ -2491,7 +2489,7 @@ testDeliveryReceipts =
     get a =##> \case ("", c, Msg "hello too") -> c == bId; _ -> False
     ackMessage a bId 6 $ Just ""
     get b =##> \case ("", c, Rcvd 6) -> c == aId; _ -> False
-    ackMessage b aId 7 (Just "") `catchError` \e -> liftIO $ e `shouldBe` A.CMD PROHIBITED
+    ackMessage b aId 7 (Just "") `catchError` \case (A.CMD PROHIBITED _) -> pure (); e -> liftIO $ expectationFailure ("unexpected error " <> show e)
     ackMessage b aId 7 Nothing
 
 testDeliveryReceiptsVersion :: HasCallStack => ATransport -> IO ()
@@ -2766,6 +2764,91 @@ testResumeMultipleThreads = do
   where
     aCfg = agentCfg {userOfflineDelay = 0}
 
+testServerQueueInfo :: IO ()
+testServerQueueInfo = do
+  withAgentClients2 $ \alice bob -> runRight_ $ do
+    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
+    liftIO $ threadDelay 200000
+    checkEmptyQ alice bobId False
+    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
+    ("", _, CONF confId _ "bob's connInfo") <- get alice
+    liftIO $ threadDelay 200000
+    checkEmptyQ alice bobId False
+    allowConnection alice bobId confId "alice's connInfo"
+    get alice ##> ("", bobId, CON)
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
+    get bob ##> ("", aliceId, CON)
+    liftIO $ threadDelay 200000
+    checkEmptyQ alice bobId True
+    checkEmptyQ bob aliceId True
+    let msgId = 4
+    (msgId', PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello"
+    liftIO $ msgId' `shouldBe` msgId
+    get alice ##> ("", bobId, SENT msgId)
+    liftIO $ threadDelay 200000
+    Just srvMsgId <- checkMsgQ bob aliceId 1
+    get bob =##> \case
+      ("", c, MSG MsgMeta {integrity = MsgOk, broker = (smId, _), recipient = (mId, _), pqEncryption = PQEncOn} _ "hello") ->
+        c == aliceId && decodeLatin1 (B64.encode smId) == srvMsgId && mId == msgId
+      _ -> False
+    ackMessage bob aliceId msgId Nothing
+    liftIO $ threadDelay 200000
+    checkEmptyQ bob aliceId True
+    (msgId1, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 1"
+    get alice ##> ("", bobId, SENT msgId1)
+    Just _ <- checkMsgQ bob aliceId 1
+    (msgId2, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 2"
+    get alice ##> ("", bobId, SENT msgId2)
+    (msgId3, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 3"
+    get alice ##> ("", bobId, SENT msgId3)
+    (msgId4, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 4"
+    get alice ##> ("", bobId, SENT msgId4)
+    Just _ <- checkMsgQ bob aliceId 4
+    (msgId5, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello: quota exceeded"
+    liftIO $ threadDelay 200000
+    Just _ <- checkMsgQ bob aliceId 5
+    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 1") -> c == aliceId && mId == msgId1; _ -> False
+    ackMessage bob aliceId msgId1 Nothing
+    liftIO $ threadDelay 200000
+    Just _ <- checkMsgQ bob aliceId 4
+    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 2") -> c == aliceId && mId == msgId2; _ -> False
+    ackMessage bob aliceId msgId2 Nothing
+    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 3") -> c == aliceId && mId == msgId3; _ -> False
+    ackMessage bob aliceId msgId3 Nothing
+    liftIO $ threadDelay 200000
+    Just _ <- checkMsgQ bob aliceId 2
+    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 4") -> c == aliceId && mId == msgId4; _ -> False
+    ackMessage bob aliceId msgId4 Nothing
+    liftIO $ threadDelay 200000
+    Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
+    get alice ##> ("", bobId, QCONT)
+    get alice ##> ("", bobId, SENT msgId5)
+    liftIO $ threadDelay 200000
+    Just _srvMsgId <- checkQ bob aliceId True (Just QNoSub) 1 (Just MTMessage)
+    get bob =##> \case ("", c, Msg' mId PQEncOn "hello: quota exceeded") -> c == aliceId && mId == msgId5 + 1; _ -> False
+    ackMessage bob aliceId (msgId5 + 1) Nothing
+    liftIO $ threadDelay 200000
+    checkEmptyQ bob aliceId True
+    pure ()
+  where
+    checkEmptyQ c cId qiSnd' = do
+      r <- checkQ c cId qiSnd' (Just QSubThread) 0 Nothing
+      liftIO $ r `shouldBe` Nothing
+    checkMsgQ c cId qiSize' = do
+      r <- checkQ c cId True (Just QNoSub) qiSize' (Just MTMessage)
+      liftIO $ isJust r `shouldBe` True
+      pure r
+    checkQ c cId qiSnd' qiSubThread_ qiSize' msgType_ = do
+      QueueInfo {qiSnd, qiNtf, qiSub, qiSize, qiMsg} <- getConnectionQueueInfo c cId
+      liftIO $ do
+        qiSnd `shouldBe` qiSnd'
+        qiNtf `shouldBe` False
+        qSubThread <$> qiSub `shouldBe` qiSubThread_
+        qiSize `shouldBe` qiSize'
+        msgId_ <- forM qiMsg $ \MsgInfo {msgId, msgType} -> msgId <$ (Just msgType `shouldBe` msgType_)
+        qDelivered <$> qiSub `shouldBe` Just msgId_
+        pure msgId_
+
 noNetworkDelay :: AgentClient -> IO ()
 noNetworkDelay a = do
   d <- waitNetwork a
@@ -2820,3 +2903,16 @@ exchangeGreetingsMsgIds alice bobId aliceMsgId bob aliceId bobMsgId = do
   get bob ##> ("", aliceId, SENT bobMsgId')
   get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
   ackMessage alice bobId aliceMsgId' Nothing
+
+newtype InternalException e = InternalException {unInternalException :: e}
+  deriving (Eq, Show)
+
+instance Exception e => Exception (InternalException e)
+
+instance Exception e => MonadUnliftIO (ExceptT e IO) where
+  {-# INLINE withRunInIO #-}
+  withRunInIO :: ((forall a. ExceptT e IO a -> IO a) -> IO b) -> ExceptT e IO b
+  withRunInIO inner =
+    ExceptT . fmap (first unInternalException) . try $
+      withRunInIO $ \run ->
+        inner $ run . (either (throwIO . InternalException) pure <=< runExceptT)

tests/AgentTests/NotificationTests.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 
 module AgentTests.NotificationTests where
 
@@ -182,7 +181,7 @@ testNotificationToken APNSMockServer {apnsQ} = do
     NTActive <- checkNtfToken a tkn
     deleteNtfToken a tkn
     -- agent deleted this token
-    Left (CMD PROHIBITED) <- tryE $ checkNtfToken a tkn
+    Left (CMD PROHIBITED _) <- tryE $ checkNtfToken a tkn
     pure ()
 
 (.->) :: J.Value -> J.Key -> ExceptT AgentErrorType IO ByteString
@@ -335,6 +334,7 @@ testNtfTokenChangeServers t APNSMockServer {apnsQ} =
         getTestNtfTokenPort a >>= \port2 -> liftIO $ port2 `shouldBe` ntfTestPort2 -- but the token got updated
       killThread ntf
       withNtfServerOn t ntfTestPort2 $ runRight_ $ do
+        liftIO $ threadDelay 1000000 -- for notification server to reconnect
         tkn <- registerTestToken a "qwer" NMInstant apnsQ
         checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive
 
@@ -374,7 +374,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@Agen
     pure (bobId, aliceId, nonce, message)
 
   -- alice client already has subscription for the connection
-  Left (CMD PROHIBITED) <- runExceptT $ getNotificationMessage alice nonce message
+  Left (CMD PROHIBITED _) <- runExceptT $ getNotificationMessage alice nonce message
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do

tests/CLITests.hs

@@ -57,7 +57,7 @@ smpServerTest :: Bool -> Bool -> IO ()
 smpServerTest storeLog basicAuth = do
   -- init
   capture_ (withArgs (["init", "-y"] <> ["-l" | storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath)
-    >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> cfgPath <> "/smp-server.ini") `isPrefixOf`))
+    >>= (`shouldSatisfy` (("Server initialized, please provide additional server information in " <> cfgPath <> "/smp-server.ini") `isPrefixOf`))
   Right ini <- readIniFile $ cfgPath <> "/smp-server.ini"
   lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
   lookupValue "STORE_LOG" "log_stats" ini `shouldBe` Right "off"
@@ -77,13 +77,13 @@ smpServerTest storeLog basicAuth = do
   let certPath = cfgPath </> "server.crt"
   oldCrt@X.Certificate {} <-
     XF.readSignedObject certPath >>= \case
-      [cert] -> pure . X.signedObject $ X.getSigned cert
+      [cert'] -> pure . X.signedObject $ X.getSigned cert'
       _ -> error "bad crt format"
   r' <- lines <$> capture_ (withArgs ["cert"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
   r' `shouldContain` ["Generated new server credentials"]
   newCrt <-
     XF.readSignedObject certPath >>= \case
-      [cert] -> pure . X.signedObject $ X.getSigned cert
+      [cert'] -> pure . X.signedObject $ X.getSigned cert'
       _ -> error "bad crt format after cert"
   X.certSignatureAlg oldCrt `shouldBe` X.certSignatureAlg newCrt
   X.certSubjectDN oldCrt `shouldBe` X.certSubjectDN newCrt

tests/CoreTests/CryptoTests.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -7,10 +8,19 @@ module CoreTests.CryptoTests (cryptoTests) where
 
 import Control.Concurrent.STM
 import Control.Monad.Except
+import qualified Crypto.Cipher.XSalsa as XSalsa
+import qualified Crypto.Error as CE
+import qualified Crypto.MAC.Poly1305 as Poly1305
+import qualified Crypto.PubKey.Curve25519 as X25519
+import Data.Bifunctor (bimap)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (isRight)
 import Data.Int (Int64)
+import Data.Memory.PtrMethods (memSet)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.Lazy as LT
@@ -19,11 +29,14 @@ import Data.Type.Equality
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.Validation as XV
+import Foreign.C.ConstPtr (ConstPtr (..))
 import qualified SMPClient
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
+import qualified Simplex.Messaging.Crypto.NaCl.Bindings as NaCl
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Transport.Client
+import System.IO.Unsafe (unsafePerformIO)
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -100,6 +113,8 @@ cryptoTests = do
     it "should validate certificates" testValidateX509
   describe "sntrup761" $
     it "should enc/dec key" testSNTRUP761
+  describe "NaCl" $
+    it "cryptobox is compatible" testNaCl
 
 instance Eq C.APublicKey where
   C.APublicKey a k == C.APublicKey a' k' = case testEquality a a' of
@@ -270,3 +285,111 @@ testSNTRUP761 = do
   (c, KEMSharedKey k) <- sntrup761Enc drg pk
   KEMSharedKey k' <- sntrup761Dec c sk
   k' `shouldBe` k
+
+testNaCl :: IO ()
+testNaCl = do
+  drg <- C.newRandom
+  (aPub :: C.PublicKeyX25519, aPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair drg
+  (bPub :: C.PublicKeyX25519, bPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair drg
+  let abShared@(C.DhSecretX25519 abShared') = C.dh' aPub bPriv
+  let baShared@(C.DhSecretX25519 baShared') = C.dh' bPub aPriv
+  abShared `shouldBe` baShared
+
+  naclShared <- either error pure $ dhNacl aPub bPriv
+  naclShared `shouldBe` abShared
+
+  naclBeforeNm <- either error pure $ cryptoBoxBeforenm aPub bPriv
+  abSharedH <- either error pure $ C.hsalsa20 abShared'
+  naclBeforeNm `shouldBe` BA.convert abSharedH
+
+  let msg = "hello long-enough world"
+  nonce@(C.CbNonce nonce') <- atomically $ C.randomCbNonce drg
+  naclCiphertext <- either (error . mappend "cryptoBox: " . show) pure $ cryptoBoxNaCl aPub bPriv nonce msg
+  let refCiphertext = ref_cryptoBox abShared' nonce' msg
+  (B.length naclCiphertext, naclCiphertext) `shouldBe` (B.length refCiphertext, refCiphertext)
+  naclCiphertextAfternm <- either error pure $ C.secretBox abSharedH nonce' msg
+  (B.length naclCiphertext, naclCiphertext) `shouldBe` (B.length naclCiphertextAfternm, naclCiphertextAfternm)
+
+  refMsg <- either (error . show) pure $ ref_sbDecryptNoPad_ baShared' nonce naclCiphertext
+  refMsg `shouldBe` msg
+
+  naclMsg <- either error pure $ cryptoBoxOpenNaCl bPub aPriv nonce refCiphertext
+  naclMsg `shouldBe` msg
+
+  naclMsgAfternm <- either error pure $ C.secretBoxOpen abSharedH nonce' naclCiphertext
+  naclMsgAfternm `shouldBe` msg
+
+-- | A replica of C.dh' using NaCl (sans hsalsa20 step)
+dhNacl :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either String (C.DhSecret 'C.X25519)
+dhNacl (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
+  (r, ba :: ScrubbedBytes) <- BA.withByteArray pub $ \pubPtr ->
+    BA.withByteArray priv $ \privPtr ->
+      BA.allocRet 32 $ \sharedPtr -> do
+        memSet sharedPtr 0 32
+        NaCl.crypto_scalarmult sharedPtr (ConstPtr privPtr) (ConstPtr pubPtr)
+  pure $! if r /= 0 then Left "crypto_scalarmult" else bimap show C.DhSecretX25519 $ CE.eitherCryptoError (X25519.dhSecret ba)
+
+cryptoBoxBeforenm :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either String ScrubbedBytes
+cryptoBoxBeforenm (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
+  (r, ba :: ScrubbedBytes) <- BA.withByteArray pub $ \pubPtr ->
+    BA.withByteArray priv $ \privPtr ->
+      BA.allocRet 32 $ \kPtr -> do
+        memSet kPtr 0 32
+        NaCl.c_crypto_box_beforenm kPtr (ConstPtr pubPtr) (ConstPtr privPtr)
+  pure $! if r /= 0 then Left "crypto_box_beforenm" else Right ba
+
+cryptoBoxNaCl :: BA.ByteArrayAccess msg => C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> msg -> Either String ByteString
+cryptoBoxNaCl (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg = unsafePerformIO $ do
+  (r, c) <-
+    BA.withByteArray msg0 $ \mPtr ->
+      BA.withByteArray n $ \nPtr ->
+        BA.withByteArray pk $ \pkPtr ->
+          BA.withByteArray sk $ \skPtr ->
+            BA.allocRet (B.length msg0) $ \cPtr ->
+              NaCl.c_crypto_box cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
+  pure $! if r /= 0 then Left "crypto_box" else Right (B.drop NaCl.crypto_box_BOXZEROBYTES c)
+  where
+    msg0 = zeroBytes <> BA.convert msg
+    zeroBytes = B.replicate NaCl.crypto_box_ZEROBYTES '\0'
+
+cryptoBoxOpenNaCl :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> Either String ByteString
+cryptoBoxOpenNaCl (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) (C.CbNonce n) ciphertext = unsafePerformIO $ do
+  (r, msg) <-
+    BA.withByteArray ciphertext0 $ \cPtr ->
+      BA.withByteArray n $ \nPtr ->
+        BA.withByteArray pub $ \pubPtr ->
+          BA.withByteArray priv $ \privPtr ->
+            BA.allocRet cLen $ \mPtr ->
+              NaCl.c_crypto_box_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr nPtr) (ConstPtr pubPtr) (ConstPtr privPtr)
+  pure $! if r /= 0 then Left "crypto_box_open" else Right (B.drop NaCl.crypto_box_ZEROBYTES msg)
+  where
+    ciphertext0 = boxZeroBytes <> ciphertext
+    boxZeroBytes = B.replicate NaCl.crypto_box_BOXZEROBYTES '\0'
+    cLen = B.length ciphertext0
+
+ref_cryptoBox :: BA.ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
+ref_cryptoBox secret nonce s = BA.convert tag <> c
+  where
+    (rs, c) = ref_xSalsa20 secret nonce s
+    tag = Poly1305.auth rs c
+
+-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
+ref_sbDecryptNoPad_ :: BA.ByteArrayAccess key => key -> C.CbNonce -> ByteString -> Either C.CryptoError ByteString
+ref_sbDecryptNoPad_ secret (C.CbNonce nonce) packet
+  | B.length packet < 16 = Left C.CBDecryptError
+  | BA.constEq tag' tag = Right msg
+  | otherwise = Left C.CBDecryptError
+  where
+    (tag', c) = B.splitAt 16 packet
+    (rs, msg) = ref_xSalsa20 secret nonce c
+    tag = Poly1305.auth rs c
+
+ref_xSalsa20 :: BA.ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
+ref_xSalsa20 secret nonce msg = (rs, msg')
+  where
+    zero = B.replicate 16 $ toEnum 0
+    (iv0, iv1) = B.splitAt 8 nonce
+    state0 = XSalsa.initialize 20 secret (zero `B.append` iv0)
+    state1 = XSalsa.derive state0 iv1
+    (rs, state2) = XSalsa.generate state1 32
+    (msg', _) = XSalsa.combine state2 msg

tests/CoreTests/UtilTests.hs

@@ -2,11 +2,11 @@
 
 module CoreTests.UtilTests where
 
+import AgentTests.FunctionalAPITests ()
 import Control.Exception (Exception, SomeException, throwIO)
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Data.IORef
-import Simplex.Messaging.Client.Agent ()
 import Simplex.Messaging.Util
 import Test.Hspec
 import qualified UnliftIO.Exception as UE

tests/NtfClient.hs

@@ -89,7 +89,7 @@ ntfServerCfg =
       clientQSize = 1,
       subQSize = 1,
       pushQSize = 1,
-      smpAgentCfg = defaultSMPClientAgentConfig,
+      smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 0},
       apnsConfig =
         defaultAPNSPushClientConfig
           { apnsPort = apnsTestPort,
@@ -115,9 +115,11 @@ ntfServerCfgV2 :: NtfServerConfig
 ntfServerCfgV2 =
   ntfServerCfg
     { ntfServerVRange = mkVersionRange initialNTFVersion authBatchCmdsNTFVersion,
-      smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}},
+      smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion}},
       Env.transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedNTFHandshakes}
     }
+  where
+    smpAgentCfg' = smpAgentCfg ntfServerCfg
 
 withNtfServerStoreLog :: ATransport -> (ThreadId -> IO a) -> IO a
 withNtfServerStoreLog t = withNtfServerCfg ntfServerCfg {storeLogFile = Just ntfTestStoreLogFile, transports = [(ntfTestPort, t)]}

tests/SMPAgentClient.hs

@@ -212,6 +212,7 @@ agentCfg =
       smpCfg = defaultSMPClientConfig {qSize = 1, defaultTransport = (testPort, transport @TLS), networkConfig},
       ntfCfg = defaultNTFClientConfig {qSize = 1, defaultTransport = (ntfTestPort, transport @TLS), networkConfig},
       reconnectInterval = fastRetryInterval,
+      persistErrorInterval = 1,
       xftpNotifyErrsOnRetry = False,
       ntfWorkerDelay = 100,
       ntfSMPWorkerDelay = 100,

tests/SMPClient.hs

@@ -59,6 +59,9 @@ testStoreLogFile2 = "tests/tmp/smp-server-store.log.2"
 testStoreMsgsFile :: FilePath
 testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
 
+testStoreMsgsFile2 :: FilePath
+testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"
+
 testServerStatsBackupFile :: FilePath
 testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
 
@@ -118,9 +121,10 @@ cfg =
       smpServerVRange = supportedServerSMPRelayVRange,
       transportConfig = defaultTransportServerConfig {Server.alpn = Just supportedSMPHandshakes},
       controlPort = Nothing,
-      smpAgentCfg = defaultSMPClientAgentConfig,
+      smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 1}, -- seconds
       allowSMPProxy = False,
-      serverClientConcurrency = 2
+      serverClientConcurrency = 2,
+      information = Nothing
     }
 
 cfgV7 :: ServerConfig
@@ -134,12 +138,10 @@ proxyCfg =
   cfgV7
     { allowSMPProxy = True,
       smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion,
-      smpAgentCfg =
-        defaultSMPClientAgentConfig
-          { smpCfg = (smpCfg defaultSMPClientAgentConfig) {serverVRange = proxyVRange, agreeSecret = True},
-            persistErrorInterval = 3 -- seconds
-          }
+      smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {serverVRange = proxyVRange, agreeSecret = True}}
     }
+  where
+    smpAgentCfg' = smpAgentCfg cfgV7
 
 proxyVRange :: VersionRangeSMP
 proxyVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion

tests/SMPProxyTests.hs

@@ -8,13 +8,16 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module SMPProxyTests where
 
+import AgentTests.EqInstances ()
 import AgentTests.FunctionalAPITests
-import Control.Monad.Trans.Except (runExceptT)
+import Control.Concurrent (ThreadId)
+import Control.Logger.Simple
+import Control.Monad (forM, forM_, forever)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import Data.ByteString.Char8 (ByteString)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -33,9 +36,12 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
+import System.FilePath (splitExtensions)
 import Test.Hspec
 import UnliftIO
+import Util
 
 smpProxyTests :: Spec
 smpProxyTests = do
@@ -71,6 +77,22 @@ smpProxyTests = do
           deliverMessageViaProxy proxyServ relayServ C.SEd25519 msg1 msg2
         it "max message size, X25519 keys" . twoServersFirstProxy $
           deliverMessageViaProxy proxyServ relayServ C.SX25519 msg1 msg2
+      describe "stress test 1k" $ do
+        let deliver n = deliverMessagesViaProxy srv1 srv2 C.SEd448 [] (map bshow [1 :: Int .. n])
+        it "1x1000" . twoServersFirstProxy $ deliver 1000
+        it "5x200" . twoServersFirstProxy $ 5 `inParrallel` deliver 200
+        it "10x100" . twoServersFirstProxy $ 10 `inParrallel` deliver 100
+      xdescribe "stress test 10k" $ do
+        let deliver n = deliverMessagesViaProxy srv1 srv2 C.SEd448 [] (map bshow [1 :: Int .. n])
+        it "1x10000" . twoServersFirstProxy $ deliver 10000
+        it "5x2000" . twoServersFirstProxy $ 5 `inParrallel` deliver 2000
+        it "10x1000" . twoServersFirstProxy $ 10 `inParrallel` deliver 1000
+        it "100x100 N1" . twoServersFirstProxy $ withNumCapabilities 1 $ 100 `inParrallel` deliver 100
+        it "100x100 N4 C1" . twoServersNoConc $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
+        it "100x100 N4 C2" . twoServersFirstProxy $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
+        it "100x100 N4 C16" . twoServersMoreConc $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
+        it "100x100 N" . twoServersFirstProxy $ withNCPUCapabilities $ 100 `inParrallel` deliver 100
+        it "500x20" . twoServersFirstProxy $ 500 `inParrallel` deliver 20
     describe "agent API" $ do
       describe "one server" $ do
         it "always via proxy" . oneServer $
@@ -92,46 +114,70 @@ smpProxyTests = do
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2"
         it "fails when fallback is prohibited" . twoServers_ proxyCfg cfgV7 $
           agentViaProxyVersionError
+        it "retries sending when destination or proxy relay is offline" $
+          agentViaProxyRetryOffline
+      describe "stress test 1k" $ do
+        let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
+        it "2 agents, 250 messages" . oneServer $ deliver 2 250
+        it "5 agents, 10 pairs, 50 messages, N1" . oneServer . withNumCapabilities 1 $ deliver 5 50
+        it "5 agents, 10 pairs, 50 messages. N4" . oneServer . withNumCapabilities 4 $ deliver 5 50
+      xdescribe "stress test 10k" $ do
+        let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
+        it "25 agents, 300 pairs, 17 messages" . oneServer . withNumCapabilities 4 $ deliver 25 17
   where
-    oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg testPort . const
+    oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg {msgQueueQuota = 128} testPort . const
     twoServers = twoServers_ proxyCfg proxyCfg
-    twoServersFirstProxy = twoServers_ proxyCfg cfgV8
+    twoServersFirstProxy = twoServers_ proxyCfg cfgV8 {msgQueueQuota = 128}
+    twoServersMoreConc = twoServers_ proxyCfg {serverClientConcurrency = 128} cfgV8 {msgQueueQuota = 128}
+    twoServersNoConc = twoServers_ proxyCfg {serverClientConcurrency = 1} cfgV8 {msgQueueQuota = 128}
     twoServers_ cfg1 cfg2 runTest =
       withSmpServerConfigOn (transport @TLS) cfg1 testPort $ \_ ->
         withSmpServerConfigOn (transport @TLS) cfg2 testPort2 $ const runTest
 
 deliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
-deliverMessageViaProxy proxyServ relayServ alg msg msg' = do
+deliverMessageViaProxy proxyServ relayServ alg msg msg' = deliverMessagesViaProxy proxyServ relayServ alg [msg] [msg']
+
+deliverMessagesViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> [ByteString] -> [ByteString] -> IO ()
+deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
   g <- C.newRandom
   -- set up proxy
-  Right pc <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing (\_ -> pure ())
+  pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing (\_ -> pure ())
+  pc <- either (fail . show) pure pc'
   THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc
   -- set up relay
-  msgQ <- newTBQueueIO 4
-  Right rc <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} (Just msgQ) (\_ -> pure ())
-  runRight_ $ do
-    -- prepare receiving queue
-    (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
-    (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-    QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe
-    let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
-    -- get proxy session
-    sess <- connectSMPProxiedRelay pc relayServ (Just "correct")
-    -- send via proxy to unsecured queue
-    Right () <- proxySMPMessage pc sess Nothing sndId noMsgFlags msg
+  msgQ <- newTBQueueIO 1024
+  rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} (Just msgQ) (\_ -> pure ())
+  rc <- either (fail . show) pure rc'
+  -- prepare receiving queue
+  (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
+  (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+  QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe
+  let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
+  -- get proxy session
+  sess0 <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
+  sess <- runExceptT' $ connectSMPProxiedRelay pc relayServ (Just "correct")
+  sess0 `shouldBe` sess
+  -- send via proxy to unsecured queue
+  forM_ unsecuredMsgs $ \msg -> do
+    runExceptT' (proxySMPMessage pc sess Nothing sndId noMsgFlags msg) `shouldReturn` Right ()
+    runExceptT' (proxySMPMessage pc sess {prSessionId = "bad session"} Nothing sndId noMsgFlags msg) `shouldReturn` Left (ProxyProtocolError $ SMP.PROXY SMP.NO_SESSION)
     -- receive 1
     (_tSess, _v, _sid, [(_entId, STEvent (Right (SMP.MSG RcvMessage {msgId, msgBody = EncRcvMsgBody encBody})))]) <- atomically $ readTBQueue msgQ
-    liftIO $ dec msgId encBody `shouldBe` Right msg
-    ackSMPMessage rc rPriv rcvId msgId
-    -- secure queue
-    (sPub, sPriv) <- atomically $ C.generateAuthKeyPair alg g
-    secureSMPQueue rc rPriv rcvId sPub
-    -- send via proxy to secured queue
-    Right () <- proxySMPMessage pc sess (Just sPriv) sndId noMsgFlags msg'
-    -- receive 2
-    (_tSess, _v, _sid, [(_entId, STEvent (Right (SMP.MSG RcvMessage {msgId = msgId', msgBody = EncRcvMsgBody encBody'})))]) <- atomically $ readTBQueue msgQ
-    liftIO $ dec msgId' encBody' `shouldBe` Right msg'
-    ackSMPMessage rc rPriv rcvId msgId'
+    dec msgId encBody `shouldBe` Right msg
+    runExceptT' $ ackSMPMessage rc rPriv rcvId msgId
+  -- secure queue
+  (sPub, sPriv) <- atomically $ C.generateAuthKeyPair alg g
+  runExceptT' $ secureSMPQueue rc rPriv rcvId sPub
+  -- send via proxy to secured queue
+  waitSendRecv
+    ( forM_ securedMsgs $ \msg' ->
+        runExceptT' (proxySMPMessage pc sess (Just sPriv) sndId noMsgFlags msg') `shouldReturn` Right ()
+    )
+    ( forM_ securedMsgs $ \msg' -> do
+        (_tSess, _v, _sid, [(_entId, STEvent (Right (SMP.MSG RcvMessage {msgId = msgId', msgBody = EncRcvMsgBody encBody'})))]) <- atomically $ readTBQueue msgQ
+        dec msgId' encBody' `shouldBe` Right msg'
+        runExceptT' $ ackSMPMessage rc rPriv rcvId msgId'
+    )
 
 agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty SMPServer, SMPProxyMode, Bool) -> (NonEmpty SMPServer, SMPProxyMode, Bool) -> C.SAlgorithm a -> ByteString -> ByteString -> IO ()
 agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 =
@@ -171,6 +217,71 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
     aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
     servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
 
+agentDeliverMessagesViaProxyConc :: [NonEmpty SMPServer] -> [MsgBody] -> IO ()
+agentDeliverMessagesViaProxyConc agentServers msgs =
+  withAgents $ \agents -> do
+    let pairs = combinations 2 agents
+    logNote $ "Pairing " <> tshow (length agents) <> " agents into " <> tshow (length pairs) <> " connections"
+    connections <- forM pairs $ \case
+      [a, b] -> prePair a b
+      _ -> error "agents must be paired"
+    logNote "Running..."
+    mapConcurrently_ run connections
+  where
+    withAgents :: ([AgentClient] -> IO ()) -> IO ()
+    withAgents action = go [] (zip [1 :: Int ..] agentServers)
+      where
+        go agents = \case
+          [] -> action agents
+          (aId, aSrvs) : next -> withAgent aId aCfg (servers aSrvs) (dbPrefix <> show aId <> dbSuffix) $ \a -> (a : agents) `go` next
+        (dbPrefix, dbSuffix) = splitExtensions testDB
+    -- agent connections have to be set up in advance
+    -- otherwise the CONF messages would get mixed with MSG
+    prePair alice bob = do
+      (bobId, qInfo) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
+      aliceId <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+      confId <-
+        get alice >>= \case
+          ("", _, A.CONF confId pqSup' _ "bob's connInfo") -> do
+            pqSup' `shouldBe` PQSupportOn
+            pure confId
+          huh -> fail $ show huh
+      runExceptT' $ allowConnection alice bobId confId "alice's connInfo"
+      get alice ##> ("", bobId, A.CON pqEnc)
+      get bob ##> ("", aliceId, A.INFO PQSupportOn "alice's connInfo")
+      get bob ##> ("", aliceId, A.CON pqEnc)
+      pure (alice, bobId, bob, aliceId)
+    -- stream messages in opposite directions, while getting deliveries and sending ACKs
+    run (alice, bobId, bob, aliceId) = do
+      aSender <- async $ forM_ msgs $ runExceptT' . A.sendMessage alice bobId pqEnc noMsgFlags
+      bRecipient <-
+        async $
+          forever $
+            get bob >>= \case
+              ("", _, A.SENT _ _) -> pure ()
+              ("", _, Msg' mId' _ _) -> runExceptT' $ ackMessage alice bobId mId' Nothing
+              huh -> fail (show huh)
+      bSender <- async $ forM_ msgs $ runExceptT' . A.sendMessage bob aliceId pqEnc noMsgFlags
+      aRecipient <-
+        async $
+          forever $
+            get alice >>= \case
+              ("", _, A.SENT _ _) -> pure ()
+              ("", _, Msg' mId' _ _) -> runExceptT' $ ackMessage alice bobId mId' Nothing
+              huh -> fail (show huh)
+      logDebug "run waiting..."
+      a2b <- async $ (waitCatch aSender >>= either throwIO pure) `finally` cancel bRecipient -- stopped sender cancels paired recipient loop
+      b2a <- async $ (waitCatch bSender >>= either throwIO pure) `finally` cancel aRecipient
+      waitEitherCatch a2b b2a >>= \case
+        Right (Right ()) -> wait b2a
+        Right (Left e) -> cancel bSender >> throwIO e
+        Left (Right ()) -> wait a2b
+        Left (Left e) -> cancel aSender >> throwIO e
+      logDebug "run finished"
+    pqEnc = CR.PQEncOn
+    aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
+    servers srvs = (initAgentServersProxy SPMAlways SPFAllow) {smp = userServers $ L.map noAuthSrv srvs}
+
 agentViaProxyVersionError :: IO ()
 agentViaProxyVersionError =
   withAgent 1 agentProxyCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do
@@ -182,6 +293,68 @@ agentViaProxyVersionError =
   where
     servers srvs = (initAgentServersProxy SPMUnknown SPFProhibit) {smp = userServers $ L.map noAuthSrv srvs}
 
+agentViaProxyRetryOffline :: IO ()
+agentViaProxyRetryOffline = do
+  let srv1 = SMPServer testHost testPort testKeyHash
+      srv2 = SMPServer testHost testPort2 testKeyHash
+      msg1 = "hello 1"
+      msg2 = "hello 2"
+      aProxySrv = Just srv1
+      bProxySrv = Just srv2
+  withAgent 1 aCfg (servers srv1) testDB $ \alice ->
+    withAgent 2 aCfg (servers srv2) testDB2 $ \bob -> do
+      let pqEnc = CR.PQEncOn
+      withServer $ \_ -> do
+        (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
+          (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe
+          aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe
+          ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
+          liftIO $ pqSup' `shouldBe` PQSupportOn
+          allowConnection alice bobId confId "alice's connInfo"
+          get alice ##> ("", bobId, A.CON pqEnc)
+          get bob ##> ("", aliceId, A.INFO PQSupportOn "alice's connInfo")
+          get bob ##> ("", aliceId, A.CON pqEnc)
+          1 <- msgId <$> A.sendMessage alice bobId pqEnc noMsgFlags msg1
+          get alice ##> ("", bobId, A.SENT (baseId + 1) aProxySrv)
+          get bob =##> \case ("", c, Msg' _ pq msg1') -> c == aliceId && pq == pqEnc && msg1 == msg1'; _ -> False
+          ackMessage bob aliceId (baseId + 1) Nothing
+          2 <- msgId <$> A.sendMessage bob aliceId pqEnc noMsgFlags msg2
+          get bob ##> ("", aliceId, A.SENT (baseId + 2) bProxySrv)
+          get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
+          ackMessage alice bobId (baseId + 2) Nothing
+          pure (aliceId, bobId)
+        runRight_ $ do
+          -- destination relay down
+          3 <- msgId <$> A.sendMessage alice bobId pqEnc noMsgFlags msg1
+          bob `down` aliceId
+        withServer2 $ \_ -> runRight_ $ do
+          bob `up` aliceId
+          get alice ##> ("", bobId, A.SENT (baseId + 3) aProxySrv)
+          get bob =##> \case ("", c, Msg' _ pq msg1') -> c == aliceId && pq == pqEnc && msg1 == msg1'; _ -> False
+          ackMessage bob aliceId (baseId + 3) Nothing
+        runRight_ $ do
+          -- proxy relay down
+          4 <- msgId <$> A.sendMessage bob aliceId pqEnc noMsgFlags msg2
+          bob `down` aliceId
+        withServer2 $ \_ -> runRight_ $ do
+          bob `up` aliceId
+          get bob ##> ("", aliceId, A.SENT (baseId + 4) bProxySrv)
+          get alice =##> \case ("", c, Msg' _ pq msg2') -> c == bobId && pq == pqEnc && msg2 == msg2'; _ -> False
+          ackMessage alice bobId (baseId + 4) Nothing
+  where
+    withServer :: (ThreadId -> IO a) -> IO a
+    withServer = withServer_ testStoreLogFile testStoreMsgsFile testPort
+    withServer2 :: (ThreadId -> IO a) -> IO a
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testPort2
+    withServer_ storeLog storeMsgs port =
+      withSmpServerConfigOn (transport @TLS) proxyCfg {storeLogFile = Just storeLog, storeMsgsFile = Just storeMsgs} port
+    a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
+    a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
+    aCfg = agentProxyCfg {messageRetryInterval = fastMessageRetryInterval}
+    baseId = 3
+    msgId = subtract baseId . fst
+    servers srv = (initAgentServersProxy SPMAlways SPFProhibit) {smp = userServers $ L.map noAuthSrv [srv]}
+
 testNoProxy :: IO ()
 testNoProxy = do
   withSmpServerConfigOn (transport @TLS) cfg testPort2 $ \_ -> do
@@ -201,3 +374,13 @@ testProxyAuth = do
 todo :: IO ()
 todo = do
   fail "TODO"
+
+runExceptT' :: Exception e => ExceptT e IO a -> IO a
+runExceptT' a = runExceptT a >>= either throwIO pure
+
+waitSendRecv :: IO () -> IO () -> IO ()
+waitSendRecv s r = do
+  s' <- async s
+  r' <- async r
+  waitCatch s' >>= either (\e -> cancel r' >> fail (show e)) pure
+  waitCatch r' >>= either (\e -> cancel s' >> fail (show e)) pure

tests/ServerTests.hs

@@ -608,7 +608,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 2
     logSize testStoreMsgsFile `shouldReturn` 5
-    logSize testServerStatsBackupFile `shouldReturn` 45
+    logSize testServerStatsBackupFile `shouldReturn` 52
     Right stats1 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats1 [rId] 5 1
 
@@ -626,7 +626,7 @@ testRestoreMessages at@(ATransport t) =
     logSize testStoreLogFile `shouldReturn` 1
     -- the last message is not removed because it was not ACK'd
     logSize testStoreMsgsFile `shouldReturn` 3
-    logSize testServerStatsBackupFile `shouldReturn` 45
+    logSize testServerStatsBackupFile `shouldReturn` 52
     Right stats2 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats2 [rId] 5 3
 
@@ -645,7 +645,7 @@ testRestoreMessages at@(ATransport t) =
 
     logSize testStoreLogFile `shouldReturn` 1
     logSize testStoreMsgsFile `shouldReturn` 0
-    logSize testServerStatsBackupFile `shouldReturn` 45
+    logSize testServerStatsBackupFile `shouldReturn` 52
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
 

tests/Util.hs

@@ -1,6 +1,28 @@
 module Util where
 
+import Control.Monad (replicateM)
+import Data.Either (partitionEithers)
+import Data.List (tails)
+import GHC.Conc (getNumCapabilities, getNumProcessors, setNumCapabilities)
 import Test.Hspec
+import UnliftIO
 
 skip :: String -> SpecWith a -> SpecWith a
 skip = before_ . pendingWith
+
+withNumCapabilities :: Int -> IO a -> IO a
+withNumCapabilities new a = getNumCapabilities >>= \old -> bracket_ (setNumCapabilities new) (setNumCapabilities old) a
+
+withNCPUCapabilities :: IO a -> IO a
+withNCPUCapabilities a = getNumProcessors >>= \p -> withNumCapabilities p a
+
+inParrallel :: Int -> IO () -> IO ()
+inParrallel n action = do
+  streams <- replicateM n $ async action
+  (es, rs) <- partitionEithers <$> mapM waitCatch streams
+  map show es `shouldBe` []
+  length rs `shouldBe` n
+
+combinations :: Int -> [a] -> [[a]]
+combinations 0 _ = [[]]
+combinations k xs = [y : ys | y : xs' <- tails xs, ys <- combinations (k - 1) xs']

tests/XFTPAgent.hs

@@ -46,7 +46,11 @@ import XFTPClient
 
 xftpAgentTests :: Spec
 xftpAgentTests = around_ testBracket . describe "agent XFTP API" $ do
-  it "should send and receive file" testXFTPAgentSendReceive
+  it "should send and receive file" $ withXFTPServer testXFTPAgentSendReceive
+  -- uncomment CPP option slow_servers and run hpack to run this test
+  xit "should send and receive file with slow server responses" $
+    withXFTPServerCfg testXFTPServerConfig {responseDelay = 500000} $
+      \_ -> testXFTPAgentSendReceive
   it "should send and receive with encrypted local files" testXFTPAgentSendReceiveEncrypted
   it "should send and receive large file with a redirect" testXFTPAgentSendReceiveRedirect
   it "should send and receive small file without a redirect" testXFTPAgentSendReceiveNoRedirect
@@ -54,7 +58,7 @@ xftpAgentTests = around_ testBracket . describe "agent XFTP API" $ do
   it "should resume receiving file after restart" testXFTPAgentReceiveRestore
   it "should cleanup rcv tmp path after permanent error" testXFTPAgentReceiveCleanup
   it "should resume sending file after restart" testXFTPAgentSendRestore
-  it "should cleanup snd prefix path after permanent error" testXFTPAgentSendCleanup
+  xit "should cleanup snd prefix path after permanent error" testXFTPAgentSendCleanup
   it "should delete sent file on server" testXFTPAgentDelete
   it "should resume deleting file after restart" testXFTPAgentDeleteRestore
   -- TODO when server is fixed to correctly send AUTH error, this test has to be modified to expect AUTH error
@@ -100,7 +104,7 @@ checkProgress (prev, expected) (progress, total) loop
   | otherwise = pure ()
 
 testXFTPAgentSendReceive :: HasCallStack => IO ()
-testXFTPAgentSendReceive = withXFTPServer $ do
+testXFTPAgentSendReceive = do
   filePath <- createRandomFile
   -- send file, delete snd file internally
   (rfd1, rfd2) <- withAgent 1 agentCfg initAgentServers testDB $ \sndr -> runRight $ do

tests/XFTPClient.hs

@@ -124,7 +124,8 @@ testXFTPServerConfig_ alpn =
       logStatsStartTime = 0,
       serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
-      transportConfig = defaultTransportServerConfig {alpn}
+      transportConfig = defaultTransportServerConfig {alpn},
+      responseDelay = 0
     }
 
 testXFTPClientConfig :: XFTPClientConfig