store missing port as empty string instead of NULL (#280)

migrations/20220101_initial.sql

@@ -1,6 +1,6 @@
 CREATE TABLE servers (
   host TEXT NOT NULL,
-  port TEXT,
+  port TEXT NOT NULL,
   key_hash BLOB NOT NULL,
   PRIMARY KEY (host, port)
 ) WITHOUT ROWID;
@@ -19,7 +19,7 @@ CREATE TABLE connections (
 
 CREATE TABLE rcv_queues (
   host TEXT NOT NULL,
-  port TEXT,
+  port TEXT NOT NULL,
   rcv_id BLOB NOT NULL,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
   rcv_private_key BLOB NOT NULL,
@@ -39,7 +39,7 @@ CREATE TABLE rcv_queues (
 
 CREATE TABLE snd_queues (
   host TEXT NOT NULL,
-  port TEXT,
+  port TEXT NOT NULL,
   snd_id BLOB NOT NULL,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
   snd_private_key BLOB NOT NULL,

src/Simplex/Messaging/Agent/Client.hs

@@ -300,7 +300,8 @@ logServer dir AgentClient {clientId} srv qId cmdStr =
   logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
 
 showServer :: SMPServer -> ByteString
-showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)
+showServer SMPServer {host, port} =
+  B.pack $ host <> if null port then "" else ':' : port
 
 logSecret :: ByteString -> ByteString
 logSecret bs = encode $ B.take 3 bs

src/Simplex/Messaging/Agent/Protocol.hs

@@ -579,7 +579,7 @@ instance StrEncoding ConnReqScheme where
       <|> "https://" *> (CRSAppServer <$> strP)
 
 simplexChat :: ConnReqScheme
-simplexChat = CRSAppServer $ SrvLoc "simplex.chat" Nothing
+simplexChat = CRSAppServer $ SrvLoc "simplex.chat" ""
 
 -- | SMP queue status.
 data QueueStatus

src/Simplex/Messaging/Client.hs

@@ -164,9 +164,9 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ dis
 
     useTransport :: (ServiceName, ATransport)
     useTransport = case port smpServer of
-      Nothing -> defaultTransport cfg
-      Just "80" -> ("80", transport @WS)
-      Just p -> (p, transport @TLS)
+      "" -> defaultTransport cfg
+      "80" -> ("80", transport @WS)
+      p -> (p, transport @TLS)
 
     client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -24,6 +24,7 @@ import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
@@ -71,11 +72,11 @@ data E2ERatchetParamsUri (a :: Algorithm)
 instance AlgorithmI a => StrEncoding (E2ERatchetParamsUri a) where
   strEncode (E2ERatchetParamsUri vs key1 key2) =
     strEncode $
-      QSP QNoEscaping [("v", strEncode vs), ("x3dh", strEncode [key1, key2])]
+      QSP QNoEscaping [("v", strEncode vs), ("x3dh", strEncodeList [key1, key2])]
   strP = do
     query <- strP
     vs <- queryParam "v" query
-    keys <- queryParam "x3dh" query
+    keys <- L.toList <$> queryParam "x3dh" query
     case keys of
       [key1, key2] -> pure $ E2ERatchetParamsUri vs key1 key2
       _ -> fail "bad e2e params"

src/Simplex/Messaging/Encoding.hs

@@ -11,6 +11,8 @@ module Simplex.Messaging.Encoding
   ( Encoding (..),
     Tail (..),
     Large (..),
+    smpEncodeList,
+    smpListP,
   )
 where
 
@@ -111,12 +113,18 @@ instance (Encoding a, Encoding b) => Encoding (a, b) where
   smpP = (,) <$> smpP <*> smpP
 
 -- lists encode/parse as a sequence of items prefixed with list length (as 1 byte)
-instance Encoding a => Encoding [a] where
-  smpEncode xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs
-  smpP = (`A.count` smpP) =<< lenP
+smpEncodeList :: Encoding a => [a] -> ByteString
+smpEncodeList xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs
+
+smpListP :: Encoding a => Parser [a]
+smpListP = (`A.count` smpP) =<< lenP
+
+instance Encoding String where
+  smpEncode = smpEncode . B.pack
+  smpP = B.unpack <$> smpP
 
 instance Encoding a => Encoding (L.NonEmpty a) where
-  smpEncode = smpEncode . L.toList
+  smpEncode = smpEncodeList . L.toList
   smpP =
     lenP >>= \case
       0 -> fail "empty list"

src/Simplex/Messaging/Encoding/String.hs

@@ -9,6 +9,8 @@ module Simplex.Messaging.Encoding.String
     strToJEncoding,
     strParseJSON,
     base64urlP,
+    strEncodeList,
+    strListP,
   )
 where
 
@@ -75,14 +77,15 @@ instance StrEncoding Word16 where
   strP = A.decimal
 
 -- lists encode/parse as comma-separated strings
-instance StrEncoding a => StrEncoding [a] where
-  strEncode = B.intercalate "," . map strEncode
-  strP = listItem `A.sepBy'` A.char ','
+strEncodeList :: StrEncoding a => [a] -> ByteString
+strEncodeList = B.intercalate "," . map strEncode
 
+strListP :: StrEncoding a => Parser [a]
+strListP = listItem `A.sepBy'` A.char ','
+
+-- relies on sepBy1 never returning an empty list
 instance StrEncoding a => StrEncoding (L.NonEmpty a) where
-  strEncode = strEncode . L.toList
-
-  -- relies on sepBy1 never returning an empty list
+  strEncode = strEncodeList . L.toList
   strP = L.fromList <$> listItem `A.sepBy1'` A.char ','
 
 listItem :: StrEncoding a => Parser a

src/Simplex/Messaging/Protocol.hs

@@ -87,7 +87,7 @@ module Simplex.Messaging.Protocol
   )
 where
 
-import Control.Applicative (optional)
+import Control.Applicative (optional, (<|>))
 import Control.Monad.Except
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -368,7 +368,7 @@ instance Encoding ClientMessage where
 -- | SMP server location and transport key digest (hash).
 data SMPServer = SMPServer
   { host :: HostName,
-    port :: Maybe ServiceName,
+    port :: ServiceName,
     keyHash :: C.KeyHash
   }
   deriving (Eq, Ord, Show)
@@ -392,12 +392,12 @@ instance StrEncoding SMPServer where
     SrvLoc host port <- strP
     pure SMPServer {host, port, keyHash}
 
-data SrvLoc = SrvLoc HostName (Maybe ServiceName)
+data SrvLoc = SrvLoc HostName ServiceName
   deriving (Eq, Ord, Show)
 
 instance StrEncoding SrvLoc where
-  strEncode (SrvLoc host port) = B.pack $ host <> maybe "" (':' :) port
-  strP = SrvLoc <$> host <*> optional port
+  strEncode (SrvLoc host port) = B.pack $ host <> if null port then "" else ':' : port
+  strP = SrvLoc <$> host <*> (port <|> pure "")
     where
       host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
       port = B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)

tests/AgentTests/ConnectionRequestTests.hs

@@ -22,7 +22,7 @@ srv :: SMPServer
 srv =
   SMPServer
     { host = "smp.simplex.im",
-      port = Just "5223",
+      port = "5223",
       keyHash = C.KeyHash "\215m\248\251"
     }
 
@@ -77,15 +77,15 @@ connectionRequestTests :: Spec
 connectionRequestTests =
   describe "connection request parsing / serializing" $ do
     it "should serialize SMP queue URIs" $ do
-      strEncode (queue :: SMPQueueUri) {smpServer = srv {port = Nothing}}
+      strEncode (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
         `shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr
       strEncode queue {clientVRange = mkVersionRange 1 2}
         `shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr
     it "should parse SMP queue URIs" $ do
       strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1&dh=" <> testDhKeyStr)
-        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = Nothing}}
+        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
       strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr)
-        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = Nothing}}
+        `shouldBe` Right (queue :: SMPQueueUri) {smpServer = srv {port = ""}}
       strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr)
         `shouldBe` Right queue
       strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr <> "/?v=1&extra_param=abc")

tests/AgentTests/SQLiteTests.hs

@@ -158,7 +158,7 @@ testDhSecret = "01234567890123456789012345678901"
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
   RcvQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+    { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
       rcvId = "1234",
       rcvPrivateKey = testPrivateSignKey,
       rcvDhSecret = testDhSecret,
@@ -171,7 +171,7 @@ rcvQueue1 =
 sndQueue1 :: SndQueue
 sndQueue1 =
   SndQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+    { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
       sndId = "3456",
       sndPrivateKey = testPrivateSignKey,
       e2eDhSecret = testDhSecret,
@@ -247,7 +247,7 @@ testCreateSndConnDuplicate =
 testGetRcvConn :: SpecWith SQLiteStore
 testGetRcvConn =
   it "should get connection using rcv queue id and server" $ \store -> do
-    let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash
+    let smpServer = SMPServer "smp.simplex.im" "5223" testKeyHash
     let recipientId = "1234"
     g <- newTVarIO =<< drgNew
     _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
@@ -301,7 +301,7 @@ testUpgradeRcvConnToDuplex =
     _ <- runExceptT $ createSndConn store g cData1 sndQueue1
     let anotherSndQueue =
           SndQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+            { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
               sndId = "2345",
               sndPrivateKey = testPrivateSignKey,
               e2eDhSecret = testDhSecret,
@@ -320,7 +320,7 @@ testUpgradeSndConnToDuplex =
     _ <- runExceptT $ createRcvConn store g cData1 rcvQueue1 SCMInvitation
     let anotherRcvQueue =
           RcvQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
+            { server = SMPServer "smp.simplex.im" "5223" testKeyHash,
               rcvId = "3456",
               rcvPrivateKey = testPrivateSignKey,
               rcvDhSecret = testDhSecret,

tests/SMPAgentClient.hs

@@ -173,7 +173,7 @@ cfg =
 
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
 withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
-  let cfg' = cfg {tcpPort = port', dbFile = db', smpServers = L.fromList [SMPServer "localhost" (Just smpPort') testKeyHash]}
+  let cfg' = cfg {tcpPort = port', dbFile = db', smpServers = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
    in serverBracket
         (\started -> runSMPAgentBlocking t started cfg')
         afterProcess