protocol: make EntityId a ShortByteString

src/Simplex/FileTransfer/Protocol.hs

@@ -38,7 +38,7 @@ module Simplex.FileTransfer.Protocol
 import qualified Data.Aeson.TH as J
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty (..))
@@ -238,14 +238,14 @@ instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand
     -- FNEW must not have signature and chunk ID
     FNEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
-      | not (B.null fileId) -> Left $ CMD HAS_AUTH
+      | not (SBS.null fileId) -> Left $ CMD HAS_AUTH
       | otherwise -> Right cmd
     PING
-      | isNothing auth && B.null fileId -> Right cmd
+      | isNothing auth && SBS.null fileId -> Right cmd
       | otherwise -> Left $ CMD HAS_AUTH
     -- other client commands must have both signature and queue ID
     _
-      | isNothing auth || B.null fileId -> Left $ CMD NO_AUTH
+      | isNothing auth || SBS.null fileId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
 
 instance ProtocolEncoding XFTPVersion XFTPErrorType FileCmd where
@@ -363,11 +363,11 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
     FRPong -> noEntity
     -- other server responses must have entity ID
     _
-      | B.null entId -> Left $ CMD NO_ENTITY
+      | SBS.null entId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
     where
       noEntity
-        | B.null entId = Right cmd
+        | SBS.null entId = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
 
 checkParty :: forall t p p'. (FilePartyI p, FilePartyI p') => t p' -> Either String (t p)

src/Simplex/FileTransfer/Server.hs

@@ -29,6 +29,7 @@ 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 qualified Data.ByteString.Short as SBS
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -716,7 +717,7 @@ randomId :: Int -> M s ByteString
 randomId n = atomically . C.randomBytes n =<< asks random
 
 getFileId :: M s XFTPFileId
-getFileId = fmap EntityId . randomId =<< asks (fileIdSize . config)
+getFileId = fmap (EntityId . SBS.toShort) . randomId =<< asks (fileIdSize . config)
 
 withFileLog :: (StoreLog 'WriteMode -> IO a) -> M s ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog

src/Simplex/FileTransfer/Server/Store/Postgres.hs

@@ -25,6 +25,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Functor (($>))
 import Data.Int (Int32, Int64)
 import Data.List (intersperse)
@@ -333,7 +334,7 @@ fileRecToCSV sId FileRec {fileInfo = FileInfo {sndKey, size, digest}, filePath,
   pure $ LB.toStrict $ BB.toLazyByteString $ mconcat (BB.char7 ',' `intersperse` fields path status) <> BB.char7 '\n'
   where
     fields path status =
-      [ renderField (toField (Binary (unEntityId sId))),
+      [ renderField (toField (Binary (SBS.fromShort $ unEntityId sId))),
         renderField (toField (fromIntegral size :: Int32)),
         renderField (toField (Binary digest)),
         renderField (toField (Binary (C.encodePubKey sndKey))),
@@ -348,8 +349,8 @@ recipientToCSV rId sId rKey =
   LB.toStrict $ BB.toLazyByteString $ mconcat (BB.char7 ',' `intersperse` fields) <> BB.char7 '\n'
   where
     fields =
-      [ renderField (toField (Binary (unEntityId rId))),
-        renderField (toField (Binary (unEntityId sId))),
+      [ renderField (toField (Binary (SBS.fromShort $ unEntityId rId))),
+        renderField (toField (Binary (SBS.fromShort $ unEntityId sId))),
         renderField (toField (Binary (C.encodePubKey rKey)))
       ]
 

src/Simplex/FileTransfer/Server/StoreLog.hs

@@ -28,6 +28,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64.URL as B64
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Composition ((.:), (.::.))
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -103,7 +104,7 @@ logAckFile :: StoreLog 'WriteMode -> RecipientId -> IO ()
 logAckFile s = logFileStoreRecord s . AckFile
 
 serverFileName :: SenderId -> FilePath
-serverFileName = B.unpack . B64.encode . unEntityId
+serverFileName = B.unpack . B64.encode . SBS.fromShort . unEntityId
 
 readWriteFileStore :: FilePath -> STMFileStore -> IO (StoreLog 'WriteMode)
 readWriteFileStore = readWriteStoreLog readFileStore writeFileStore

src/Simplex/Messaging/Agent.hs

@@ -173,6 +173,7 @@ import qualified Data.Aeson.TH as JQ
 import Data.Bifunctor (bimap, first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Composition
 import Data.Either (fromRight, isRight, partitionEithers, rights)
 import Data.Foldable (foldl', toList)
@@ -1044,7 +1045,7 @@ prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNo
   plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
   plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
   addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys pqInitKeys else pure Nothing
-  let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
+  let sndId = SMP.EntityId $ SBS.toShort $ B.take 24 $ C.sha3_384 corrId
       qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact)
       connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_)
       (plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq (Just linkEntityId)
@@ -1360,7 +1361,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
       sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
       AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
       -- the remaining 24 bytes are reserved, possibly for notifier ID in the new notifications protocol
-      let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
+      let sndId = SMP.EntityId $ SBS.toShort $ B.take 24 $ C.sha3_384 corrId
           qm = case cMode of SCMContact -> QMContact; SCMInvitation -> QMMessaging
           qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey (Just qm)
       connReq <- createConnReq addrKeys_ qUri

src/Simplex/Messaging/Agent/Client.hs

@@ -211,6 +211,7 @@ import Data.Bifunctor (bimap, first, second)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Composition ((.:), (.:.))
 import Data.Containers.ListUtils (nubOrd)
 import Data.Either (isRight, partitionEithers)
@@ -1161,7 +1162,7 @@ withLogClient c nm tSess entId cmdStr action = withLogClient_ c nm tSess entId c
 withSMPClient :: SMPQueueRec q => AgentClient -> NetworkRequestMode -> q -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> AM a
 withSMPClient c nm q cmdStr action = do
   tSess <- mkSMPTransportSessionIO c q
-  withLogClient c nm tSess (unEntityId $ queueId q) cmdStr $ action . connectedClient
+  withLogClient c nm tSess (SBS.fromShort $ unEntityId $ queueId q) cmdStr $ action . connectedClient
 
 sendOrProxySMPMessage :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> ConnId -> ByteString -> Maybe SMP.SndPrivateAuthKey -> SMP.SenderId -> MsgFlags -> SMP.MsgBody -> AM (Maybe SMPServer)
 sendOrProxySMPMessage c nm userId destSrv connId cmdStr spKey_ senderId msgFlags msg =
@@ -1255,7 +1256,7 @@ sendOrProxySMPCommand c nm userId destSrv@ProtocolServer {host = destHosts} conn
           | serverHostError e -> ifM directAllowed ((Nothing,) <$> sendDirectly destSess) (throwE e)
           | otherwise -> throwE e
     sendDirectly tSess =
-      withLogClient_ c nm tSess (unEntityId entId) ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
+      withLogClient_ c nm tSess (SBS.fromShort $ unEntityId entId) ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do
         tryAllErrors (liftClient SMP (clientServer smp) $ sendCmdDirectly smp) >>= \case
           Right r -> r <$ atomically (incSMPServerStat c userId destSrv sentDirect)
           Left e -> throwE e
@@ -1270,7 +1271,7 @@ ipAddressProtected NetworkConfig {socksProxy, socksMode, hostMode} (ProtocolServ
     isOnionHost = \case THOnionHost _ -> True; _ -> False
 
 withNtfClient :: AgentClient -> NetworkRequestMode -> NtfServer -> EntityId -> ByteString -> (NtfClient -> ExceptT NtfClientError IO a) -> AM a
-withNtfClient c nm srv (EntityId entId) = withLogClient c nm (0, srv, Nothing) entId
+withNtfClient c nm srv (EntityId entId) = withLogClient c nm (0, srv, Nothing) $ SBS.fromShort entId
 
 withXFTPClient ::
   ProtocolServerClient v err msg =>
@@ -1929,7 +1930,7 @@ getSubscriptions = readTVarIO . subscrConns
 {-# INLINE getSubscriptions #-}
 
 logServer :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> EntityId -> ByteString -> m ()
-logServer dir c srv = logServer' dir c srv . unEntityId
+logServer dir c srv = logServer' dir c srv . SBS.fromShort . unEntityId
 {-# INLINE logServer #-}
 
 logServer' :: MonadIO m => ByteString -> AgentClient -> ProtocolServer s -> ByteString -> ByteString -> m ()
@@ -1942,7 +1943,7 @@ showServer ProtocolServer {host, port} =
 {-# INLINE showServer #-}
 
 logSecret :: EntityId -> ByteString
-logSecret = logSecret' . unEntityId
+logSecret = logSecret' . SBS.fromShort . unEntityId
 {-# INLINE logSecret #-}
 
 logSecret' :: ByteString -> ByteString
@@ -2007,14 +2008,14 @@ deleteQueueLink c nm rq@RcvQueue {rcvId, rcvPrivateKey} =
 
 secureGetQueueLink :: AgentClient -> NetworkRequestMode -> UserId -> InvShortLink -> AM (SMP.SenderId, QueueLinkData)
 secureGetQueueLink c nm userId InvShortLink {server, linkId, sndPrivateKey} =
-  snd <$> sendOrProxySMPCommand c nm userId server (unEntityId linkId) "LKEY <key>" linkId secureGetViaProxy secureGetDirectly
+  snd <$> sendOrProxySMPCommand c nm userId server (SBS.fromShort $ unEntityId linkId) "LKEY <key>" linkId secureGetViaProxy secureGetDirectly
   where
     secureGetViaProxy smp proxySess = proxySecureGetSMPQueueLink smp nm proxySess sndPrivateKey linkId
     secureGetDirectly smp = secureGetSMPQueueLink smp nm sndPrivateKey linkId
 
 getQueueLink :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> SMP.LinkId -> AM (SMP.SenderId, QueueLinkData)
 getQueueLink c nm userId server lnkId =
-  snd <$> sendOrProxySMPCommand c nm userId server (unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly
+  snd <$> sendOrProxySMPCommand c nm userId server (SBS.fromShort $ unEntityId lnkId) "LGET" lnkId getViaProxy getDirectly
   where
     getViaProxy smp proxySess = proxyGetSMPQueueLink smp nm proxySess lnkId
     getDirectly smp = getSMPQueueLink smp nm lnkId
@@ -2148,7 +2149,7 @@ getQueueInfo c nm rq@RcvQueue {server, rcvId, rcvPrivateKey, sndId, status, clie
     let ntfId = enc . (\ClientNtfCreds {notifierId} -> notifierId) <$> clientNtfCreds
     pure ServerQueueInfo {server, rcvId = enc rcvId, sndId = enc sndId, ntfId, status = serializeQueueStatus status, info}
   where
-    enc = decodeLatin1 . B64.encode . unEntityId
+    enc = decodeLatin1 . B64.encode . SBS.fromShort . unEntityId
 
 agentNtfRegisterToken :: AgentClient -> NetworkRequestMode -> NtfToken -> SMP.NtfPublicAuthKey -> C.PublicKeyX25519 -> AM (NtfTokenId, C.PublicKeyX25519)
 agentNtfRegisterToken c nm NtfToken {deviceToken, ntfServer, ntfPrivKey} ntfPubKey pubDhKey =

src/Simplex/Messaging/Agent/Protocol.hs

@@ -212,6 +212,7 @@ import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Char (toLower, toUpper)
 import Data.Foldable (find)
 import Data.Functor (($>))
@@ -1720,7 +1721,7 @@ instance FromJSON AConnectionLink where
 
 instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
   strEncode = \case
-    CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' lnkId k
+    CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k) -> slEncode sch srv 'i' (SBS.fromShort lnkId) k
     CSLContact sch ct srv (LinkKey k) -> slEncode sch srv (toLower $ ctTypeChar ct) "" k
     where
       slEncode sch (SMPServer (h :| hs) port (C.KeyHash kh)) linkType lnkId k =
@@ -1750,7 +1751,7 @@ instance StrEncoding AConnShortLink where
         lnkId <- strP <* A.char '/'
         k <- strP
         srv <- serverQueryP h_
-        pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId lnkId) (LinkKey k)
+        pure $ ACSL SCMInvitation $ CSLInvitation sch srv (SMP.EntityId $ SBS.toShort lnkId) (LinkKey k)
       Just ct -> do
         k <- strP
         srv <- serverQueryP h_

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

@@ -296,6 +296,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -2265,9 +2266,9 @@ instance ToField (Version v) where toField (Version v) = toField v
 
 deriving newtype instance FromField (Version v)
 
-instance ToField EntityId where toField (EntityId s) = toField $ Binary s
+instance ToField EntityId where toField (EntityId s) = toField $ Binary $ SBS.fromShort s
 
-deriving newtype instance FromField EntityId
+instance FromField EntityId where fromField = blobFieldDecoder $ Right . EntityId . SBS.toShort
 
 deriving newtype instance ToField ChunkReplicaId
 

src/Simplex/Messaging/Client.hs

@@ -145,6 +145,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Short as SBS
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (find, isSuffixOf)
@@ -1237,7 +1238,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
   et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret (encTransmissionNonce v nonce) b paddedProxiedTLength
   -- proxy interaction errors are wrapped
   let tOut = Just $ 2 * netTimeoutInt tcpTimeout nm
-  tryE (sendProtocolCommand_ c nm (Just nonce) tOut Nothing (EntityId sessionId) (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
+  tryE (sendProtocolCommand_ c nm (Just nonce) tOut Nothing (EntityId $ SBS.toShort sessionId) (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
     Right r -> case r of
       PRES nonce_ (EncResponse er) -> do
         -- server interaction errors are thrown directly

src/Simplex/Messaging/Crypto/ShortLink.hs

@@ -31,6 +31,7 @@ import Data.Bifunctor (first)
 import Data.Bitraversable (bimapM)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Short as SBS
 import Simplex.Messaging.Agent.Client (cryptoError)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
@@ -47,7 +48,7 @@ userDataPaddedLength = 13784 -- 13824 - 24 - 16
 contactShortLinkKdf :: LinkKey -> (LinkId, C.SbKey)
 contactShortLinkKdf (LinkKey k) =
   let (lnkId, sbKey) = B.splitAt 24 $ C.hkdf "" k "SimpleXContactLink" 56
-   in (EntityId lnkId, C.unsafeSbKey sbKey)
+   in (EntityId $ SBS.toShort lnkId, C.unsafeSbKey sbKey)
 
 invShortLinkKdf :: LinkKey -> C.SbKey
 invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -47,6 +47,7 @@ import qualified Data.Aeson.Encoding as JE
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Functor (($>))
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty (..))
@@ -248,16 +249,16 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh
     TNEW {} -> sigNoEntity
     SNEW {} -> sigNoEntity
     PING
-      | isNothing auth && B.null entityId -> Right cmd
+      | isNothing auth && SBS.null entityId -> Right cmd
       | otherwise -> Left $ CMD HAS_AUTH
     -- other client commands must have both signature and entity ID
     _
-      | isNothing auth || B.null entityId -> Left $ CMD NO_AUTH
+      | isNothing auth || SBS.null entityId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
     where
       sigNoEntity
         | isNothing auth = Left $ CMD NO_AUTH
-        | not (B.null entityId) = Left $ CMD HAS_AUTH
+        | not (SBS.null entityId) = Left $ CMD HAS_AUTH
         | otherwise = Right cmd
 
 instance ProtocolEncoding NTFVersion ErrorType NtfCmd where
@@ -368,11 +369,11 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where
     NRPong -> noEntity
     -- other server responses must have entity ID
     _
-      | B.null entId -> Left $ CMD NO_ENTITY
+      | SBS.null entId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
     where
       noEntity
-        | B.null entId = Right cmd
+        | SBS.null entId = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
 
 data SMPQueueNtf = SMPQueueNtf

src/Simplex/Messaging/Notifications/Server.hs

@@ -32,6 +32,7 @@ import Control.Monad.Reader
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.Hashable (hash)
@@ -948,7 +949,7 @@ client NtfServerClient {rcvQ, sndQ} ns@NtfSubscriber {smpAgent = ca} ps =
           PING -> pure NRPong
       NtfReqPing corrId entId -> pure (corrId, entId, NRPong)
     getId :: M NtfEntityId
-    getId = fmap EntityId . randomBytes =<< asks (subIdBytes . config)
+    getId = fmap (EntityId . SBS.toShort) . randomBytes =<< asks (subIdBytes . config)
     getRegCode :: M NtfRegCode
     getRegCode = NtfRegCode <$> (randomBytes =<< asks (regCodeBytes . config))
     randomBytes :: Int -> M ByteString

src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs

@@ -62,6 +62,7 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Short as SBS
 import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -233,7 +234,7 @@ deleteNtfToken st tknId =
     toServerSubs :: SMPServerRow :. Only Text -> (SMPServer, [NotifierId])
     toServerSubs (srv :. Only nIdsStr) = (rowToSrv srv, parseByteaString nIdsStr)
     parseByteaString :: Text -> [NotifierId]
-    parseByteaString s = mapMaybe (fmap EntityId . decodeHex . T.drop 2) $ T.splitOn "," s  -- drop 2 to remove "\\x"
+    parseByteaString s = mapMaybe (fmap (EntityId . SBS.toShort) . decodeHex . T.drop 2) $ T.splitOn "," s  -- drop 2 to remove "\\x"
 
 type SMPServerRow = (NonEmpty TransportHost, ServiceName, C.KeyHash)
 

src/Simplex/Messaging/Protocol.hs

@@ -248,6 +248,7 @@ import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Char (isPrint, isSpace)
 import Data.Constraint (Dict (..))
 import Data.Functor (($>))
@@ -1553,7 +1554,7 @@ queueIdsHash :: [QueueId] -> IdsHash
 queueIdsHash = mconcat . map queueIdHash
 
 queueIdHash :: QueueId -> IdsHash
-queueIdHash = IdsHash . C.md5Hash . unEntityId
+queueIdHash = IdsHash . C.md5Hash . SBS.fromShort . unEntityId
 {-# INLINE queueIdHash #-}
 
 addServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
@@ -1868,11 +1869,11 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     -- NEW must have signature but NOT queue ID
     NEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
-      | not (B.null entId) -> Left $ CMD HAS_AUTH
+      | not (SBS.null entId) -> Left $ CMD HAS_AUTH
       | otherwise -> Right cmd
     -- SEND must have queue ID, signature is not always required
     SEND {}
-      | B.null entId -> Left $ CMD NO_ENTITY
+      | SBS.null entId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
     LGET -> entityCmd
     PING -> noAuthCmd
@@ -1884,22 +1885,22 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
     NSUB -> serviceCmd
     -- other client commands must have both signature and queue ID
     _
-      | isNothing auth || B.null entId -> Left $ CMD NO_AUTH
+      | isNothing auth || SBS.null entId -> Left $ CMD NO_AUTH
       | otherwise -> Right cmd
     where
       -- command must not have entity ID (queue or session ID) or signature
       noAuthCmd :: Either ErrorType (Command p)
       noAuthCmd
-        | isNothing auth && B.null entId = Right cmd
+        | isNothing auth && SBS.null entId = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
       entityCmd :: Either ErrorType (Command p)
       entityCmd
-        | B.null entId = Left $ CMD NO_ENTITY
+        | SBS.null entId = Left $ CMD NO_ENTITY
         | isNothing auth = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
       serviceCmd :: Either ErrorType (Command p)
       serviceCmd
-        | isNothing auth || B.null entId = Left $ CMD NO_AUTH
+        | isNothing auth || SBS.null entId = Left $ CMD NO_AUTH
         | otherwise = Right cmd
 
 instance ProtocolEncoding SMPVersion ErrorType Cmd where
@@ -2086,12 +2087,12 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     RNAME {} -> noEntityMsg
     -- other broker responses must have queue ID
     _
-      | B.null entId -> Left $ CMD NO_ENTITY
+      | SBS.null entId -> Left $ CMD NO_ENTITY
       | otherwise -> Right cmd
     where
       noEntityMsg :: Either ErrorType BrokerMsg
       noEntityMsg
-        | B.null entId = Right cmd
+        | SBS.null entId = Right cmd
         | otherwise = Left $ CMD HAS_AUTH
 
 -- | Parse SMP protocol commands and broker messages

src/Simplex/Messaging/Server.hs

@@ -62,6 +62,7 @@ import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Constraint (Dict (..))
 import Data.Dynamic (toDyn)
 import Data.Either (fromRight, partitionEithers)
@@ -748,7 +749,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
 
     getClientService :: s -> TVar ChaChaDRG -> Int -> SMPServiceRole -> X.CertificateChain -> XV.Fingerprint -> ExceptT TransportError IO ServiceId
     getClientService ms g idSize role cert fp = do
-      newServiceId <- EntityId <$> atomically (C.randomBytes idSize g)
+      newServiceId <- EntityId . SBS.toShort <$> atomically (C.randomBytes idSize g)
       ts <- liftIO getSystemDate
       let sr = ServiceRec {serviceId = newServiceId, serviceRole = role, serviceCert = cert, serviceCertHash = fp, serviceCreatedAt = ts}
       withExceptT (const $ TEHandshake BAD_SERVICE) $ ExceptT $
@@ -1452,7 +1453,7 @@ client
         ProxyAgent {smpAgent = a} <- asks proxyAgent
         ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats
         let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn
-        liftIO (lookupSMPServerClient a sessId) >>= \case
+        liftIO (lookupSMPServerClient a $ SBS.fromShort sessId) >>= \case
           Just (own, smp) -> do
             inc own pRequests
             forkProxiedCmd $ do
@@ -1574,9 +1575,9 @@ client
               ntfKeys_ <- forM ntfCreds $ \(NewNtfCreds notifierKey dhKey) -> do
                 (ntfPubDhKey, ntfPrivDhKey) <- atomically $ C.generateKeyPair g
                 pure (notifierKey, C.dh' dhKey ntfPrivDhKey, ntfPubDhKey)
-              let randId = EntityId <$> atomically (C.randomBytes idSize g)
+              let randId = EntityId . SBS.toShort <$> atomically (C.randomBytes idSize g)
                   -- the remaining 24 bytes are reserved, possibly for notifier ID in the new notifications protocol
-                  sndId' = B.take 24 $ C.sha3_384 (bs corrId)
+                  sndId' = EntityId $ SBS.toShort $ B.take 24 $ C.sha3_384 (bs corrId)
                   tryCreate 0 = pure $ ERR INTERNAL
                   tryCreate n = do
                     (sndId, clntIds, queueData) <- case queueReqData of
@@ -1586,7 +1587,7 @@ client
                     -- The condition that client-provided sender ID must match hash of correlation ID
                     -- prevents "ID oracle" attack, when creating queue with supplied ID can be used to check
                     -- if queue with this ID still exists.
-                    if clntIds && unEntityId sndId /= sndId'
+                    if clntIds && sndId /= sndId'
                       then pure $ ERR $ CMD PROHIBITED
                       else do
                         rcvId <- randId
@@ -2269,7 +2270,7 @@ randomId' :: Int -> M s ByteString
 randomId' n = atomically . C.randomBytes n =<< asks random
 
 randomId :: Int -> M s EntityId
-randomId = fmap EntityId . randomId'
+randomId = fmap (EntityId . SBS.toShort) . randomId'
 {-# INLINE randomId #-}
 
 saveServerMessages :: Bool -> MsgStore s -> IO ()
@@ -2394,7 +2395,7 @@ importMessages tty ms f old_ skipWarnings  = do
             Right q -> addToQueue_ q rId msg
             Left AUTH -> liftIO $ do
               when tty $ putStrLn ""
-              warnOrExit $ "queue " <> safeDecodeUtf8 (encode $ unEntityId rId) <> " does not exist"
+              warnOrExit $ "queue " <> safeDecodeUtf8 (encode $ SBS.fromShort $ unEntityId rId) <> " does not exist"
               pure (Nothing, counts)
             Left e -> throwE e
         addToQueue_ q rId msg =

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

@@ -88,7 +88,6 @@ import Control.Monad
 import qualified Crypto.PubKey.RSA as RSA
 import Crypto.Random
 import Data.ByteString.Short (ShortByteString)
-import qualified Data.ByteString.Short as SBS
 import Data.Int (Int64)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
@@ -399,7 +398,7 @@ data SubscribedClients s = SubscribedClients (TMap SubKey (TVar (Maybe (Client s
 type SubKey = ShortByteString
 
 subKey :: EntityId -> SubKey
-subKey = SBS.toShort . unEntityId
+subKey = unEntityId
 {-# INLINE subKey #-}
 
 getSubscribedClients :: SubscribedClients s -> IO (Map SubKey (TVar (Maybe (Client s))))

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

@@ -48,6 +48,7 @@ import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Builder as BB
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as SBS
 import Data.Bitraversable (bimapM)
 import Data.Either (fromRight, lefts)
 import Data.Functor (($>))
@@ -801,9 +802,9 @@ instance ToField SMPServiceRole where toField = toField . decodeLatin1 . smpEnco
 instance FromField SMPServiceRole where fromField = fromTextField_ $ eitherToMaybe . smpDecode . encodeUtf8
 
 #if !defined(dbPostgres)
-instance ToField EntityId where toField (EntityId s) = toField $ Binary s
+instance ToField EntityId where toField (EntityId s) = toField $ Binary $ SBS.fromShort s
 
-deriving newtype instance FromField EntityId
+instance FromField EntityId where fromField = blobFieldDecoder $ Right . EntityId . SBS.toShort
 
 instance FromField QueueMode where fromField = fromTextField_ $ eitherToMaybe . smpDecode . encodeUtf8
 

src/Simplex/Messaging/Transport.hs

@@ -120,6 +120,8 @@ import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.ByteString.Short (ShortByteString)
+import qualified Data.ByteString.Short as SBS
 import Data.Default (def)
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -526,9 +528,20 @@ type SessionId = ByteString
 type ServiceId = EntityId
 
 -- this type is used for server entities only
-newtype EntityId = EntityId {unEntityId :: ByteString}
+-- ShortByteString is unpinned, so long-lived IDs (map keys) do not retain the pinned block they were parsed from
+newtype EntityId = EntityId {unEntityId :: ShortByteString}
   deriving (Eq, Ord, Show)
-  deriving newtype (Encoding, StrEncoding)
+
+instance Encoding EntityId where
+  smpEncode (EntityId s) = smpEncode $ SBS.fromShort s
+  {-# INLINE smpEncode #-}
+  smpP = EntityId . SBS.toShort <$> smpP
+  {-# INLINE smpP #-}
+
+instance StrEncoding EntityId where
+  strEncode (EntityId s) = strEncode $ SBS.fromShort s
+  strDecode = fmap (EntityId . SBS.toShort) . strDecode
+  strP = EntityId . SBS.toShort <$> strP
 
 pattern NoEntity :: EntityId
 pattern NoEntity = EntityId ""

tests/CoreTests/BatchingTests.hs

@@ -14,6 +14,7 @@ import Control.Monad
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Short as SBS
 import qualified Data.List.NonEmpty as L
 import Data.Time.Clock.System (SystemTime, getSystemTime)
 import qualified Data.X509 as X
@@ -182,7 +183,7 @@ randomSUB sessId = do
   (rKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   thAuth_ <- testTHandleAuth g rKey
   let thParams = testTHandleParams sessId
-      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
+      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId (SBS.toShort rId), Cmd SRecipient SUB)
   pure $ (,tToSend) <$> authTransmission thAuth_ True (Just rpKey) nonce tForAuth
 
 randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
@@ -190,13 +191,13 @@ randomSUBCmd c = do
   g <- C.newRandom
   rId <- atomically $ C.randomBytes 24 g
   (_, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  mkTransmission c (EntityId rId, Just rpKey, Cmd SRecipient SUB)
+  mkTransmission c (EntityId (SBS.toShort rId), Just rpKey, Cmd SRecipient SUB)
 
 randomENDCmd :: IO (Transmission BrokerMsg)
 randomENDCmd = do
   g <- C.newRandom
   rId <- atomically $ C.randomBytes 24 g
-  pure (CorrId "", EntityId rId, END)
+  pure (CorrId "", EntityId (SBS.toShort rId), END)
 
 randomNMSGCmd :: SystemTime -> IO (Transmission BrokerMsg)
 randomNMSGCmd ts = do
@@ -207,14 +208,14 @@ randomNMSGCmd ts = do
   nonce <- atomically $ C.randomCbNonce g
   let msgMeta = NMsgMeta {msgId, msgTs = ts}
   Right encNMsgMeta <- pure $ C.cbEncrypt (C.dh' k pk) nonce (smpEncode msgMeta) 128
-  pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta)
+  pure (CorrId "", EntityId (SBS.toShort nId), NMSG nonce encNMsgMeta)
 
 randomSOK :: IO (Transmission BrokerMsg)
 randomSOK = do
   g <- C.newRandom
   corrId <- atomically $ C.randomBytes 24 g
   rId <- atomically $ C.randomBytes 24 g
-  pure (CorrId corrId, EntityId rId, SOK Nothing)
+  pure (CorrId corrId, EntityId (SBS.toShort rId), SOK Nothing)
 
 randomMSG :: IO (Transmission BrokerMsg)
 randomMSG = do
@@ -223,7 +224,7 @@ randomMSG = do
   rId <- atomically $ C.randomBytes 24 g
   msgId <- atomically $ C.randomBytes 24 g
   msg <- atomically $ C.randomBytes maxMessageLength g
-  pure (CorrId corrId, EntityId rId, MSG RcvMessage {msgId, msgBody = EncRcvMsgBody msg})
+  pure (CorrId corrId, EntityId (SBS.toShort rId), MSG RcvMessage {msgId, msgBody = EncRcvMsgBody msg})
 
 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TAuthorizations, ByteString))
 randomSEND sessId len = do
@@ -234,7 +235,7 @@ randomSEND sessId len = do
   thAuth_ <- testTHandleAuth g sKey
   msg <- atomically $ C.randomBytes len g
   let thParams = testTHandleParams sessId
-      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
+      TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId (SBS.toShort sId), Cmd SSender $ SEND noMsgFlags msg)
   pure $ (,tToSend) <$> authTransmission thAuth_ False (Just spKey) nonce tForAuth
 
 testTHandleParams :: ByteString -> THandleParams SMPVersion 'TClient
@@ -269,7 +270,7 @@ randomSENDCmd c len = do
   sId <- atomically $ C.randomBytes 24 g
   (_, rpKey) <- atomically $ C.generateAuthKeyPair C.SX25519 g
   msg <- atomically $ C.randomBytes len g
-  mkTransmission c (EntityId sId, Just rpKey, Cmd SSender $ SEND noMsgFlags msg)
+  mkTransmission c (EntityId (SBS.toShort sId), Just rpKey, Cmd SSender $ SEND noMsgFlags msg)
 
 lenOk :: ByteString -> Bool
 lenOk s = 0 < B.length s && B.length s <= smpBlockSize - 2

tests/CoreTests/MsgStoreTests.hs

@@ -26,6 +26,7 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Int (Int64)
 import Data.List (isPrefixOf, isSuffixOf)
 import Data.Maybe (fromJust)
@@ -183,7 +184,7 @@ testNewQueueRecData g qm queueData = do
           }
   pure (rId, qr)
   where
-    rndId = atomically $ EntityId <$> C.randomBytes 24 g
+    rndId = atomically $ EntityId . SBS.toShort <$> C.randomBytes 24 g
 
 testGetQueue :: MsgStoreClass s => s -> IO ()
 testGetQueue ms = do
@@ -274,7 +275,7 @@ testLinkDataSecuredQueue ms = do
   (sKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   let st = queueStore ms
       ld = (EncDataBytes "fixed data", EncDataBytes "user data")
-      rndId = atomically $ EntityId <$> C.randomBytes 24 g
+      rndId = atomically $ EntityId . SBS.toShort <$> C.randomBytes 24 g
   (rId, qr) <- testNewQueueRec g QMMessaging
   (cId, cqr) <- testNewQueueRec g QMContact
   lnkId <- rndId
@@ -459,7 +460,7 @@ testExpireMessagesInBatches ms = do
 testQueueState :: JournalMsgStore s -> IO ()
 testQueueState ms = do
   g <- C.newRandom
-  rId <- EntityId <$> atomically (C.randomBytes 24 g)
+  rId <- EntityId . SBS.toShort <$> atomically (C.randomBytes 24 g)
   let dir = msgQueueDirectory ms rId
       statePath = msgQueueStatePath dir rId
   createDirectoryIfMissing True dir

tests/CoreTests/StoreLogTests.hs

@@ -14,6 +14,7 @@ import Control.Monad
 import CoreTests.MsgStoreTests
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Either (partitionEithers)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -79,7 +80,7 @@ storeLogTests =
     ((rId, qr), ntfCreds, date, sr@ServiceRec {serviceId}) <- runIO $
       (,,,) <$> testNewQueueRec g qm <*> testNtfCreds g <*> getSystemDate <*> newTestServiceRec g
     ((rId', qr'), lnkId, qd) <- runIO $ do
-      lnkId <- atomically $ EntityId <$> C.randomBytes 24 g
+      lnkId <- atomically $ EntityId . SBS.toShort <$> C.randomBytes 24 g
       let qd = (EncDataBytes "fixed data", EncDataBytes "user data")
       q <- testNewQueueRecData g qm (Just (lnkId, qd))
       pure (q, lnkId, qd)
@@ -157,7 +158,7 @@ storeLogTests =
 
 newTestServiceRec :: TVar ChaChaDRG -> IO ServiceRec
 newTestServiceRec g = do
-  serviceId <- atomically $ EntityId <$> C.randomBytes 24 g
+  serviceId <- atomically $ EntityId . SBS.toShort <$> C.randomBytes 24 g
   (_, cert) <- genCredentials g Nothing (0, 2400) "ntf.example.com"
   serviceCreatedAt <- getSystemDate
   pure
@@ -233,7 +234,7 @@ fileStoreLogTests :: Spec
 fileStoreLogTests = do
   g <- runIO C.newRandom
   (sndKey, _) <- runIO $ atomically $ C.generateAuthKeyPair C.SEd25519 g
-  sId <- runIO $ atomically $ EntityId <$> C.randomBytes 24 g
+  sId <- runIO $ atomically $ EntityId . SBS.toShort <$> C.randomBytes 24 g
   let file = FileInfo {sndKey, size = 16384, digest = "12345678"}
       createdAt = RoundedSystemTime 1600000000
       expiresAt = RoundedSystemTime 1600172800

tests/CoreTests/TSessionSubs.hs

@@ -10,6 +10,7 @@ module CoreTests.TSessionSubs where
 import AgentTests.EqInstances ()
 import Control.Monad
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.List (foldl')
 import qualified Data.Map as M
 import Data.String (IsString (..))
@@ -27,7 +28,7 @@ import Util
 tSessionSubsTests :: Spec
 tSessionSubsTests = it "subscription lifecycle" $ testSessionSubs
 
-instance IsString EntityId where fromString = EntityId . B.pack
+instance IsString EntityId where fromString = EntityId . SBS.toShort . B.pack
 
 dumpSessionSubs :: SS.TSessionSubs -> IO (M.Map SMPTransportSession (Maybe SessionId, (M.Map RecipientId RcvQueueSub, M.Map RecipientId RcvQueueSub)))
 dumpSessionSubs =

tests/NtfClient.hs

@@ -25,6 +25,7 @@ import qualified Data.Aeson.Types as JT
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
@@ -208,7 +209,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
       pure ()
     tGet' h = do
       [(CorrId corrId, EntityId qId, Right cmd)] <- tGetClient h
-      pure (Nothing, corrId, qId, cmd)
+      pure (Nothing, corrId, SBS.fromShort qId, cmd)
 
 ntfTest :: Transport c => TProxy c 'TServer -> (THandleNTF c 'TClient -> IO ()) -> Expectation
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()

tests/SMPClient.hs

@@ -18,6 +18,7 @@ module SMPClient where
 import Control.Monad
 import Control.Monad.Except (runExceptT)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Short as SBS
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
@@ -452,7 +453,7 @@ smpServerTest _ t = runSmpTest (ASType SQSMemory SMSJournal) $ \h -> tPut' h t >
       pure ()
     tGet' h = do
       [(CorrId corrId, EntityId qId, Right cmd)] <- tGetClient h
-      pure (Nothing, corrId, qId, cmd)
+      pure (Nothing, corrId, SBS.fromShort qId, cmd)
 
 smpTest :: (HasCallStack, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
 smpTest _ msType test' = runSmpTest msType test' `shouldReturn` ()

tests/ServerTests.hs

@@ -29,6 +29,7 @@ import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Short as SBS
 import Data.Foldable (foldrM)
 import Data.Hashable (hash)
 import qualified Data.IntSet as IS
@@ -489,13 +490,13 @@ testDuplex =
       (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", NoEntity, New brPub bDhPub)
       let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
-      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> B64.encode (unEntityId bSnd))
+      Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> B64.encode (SBS.fromShort $ unEntityId bSnd))
       -- "reply_id ..." is ad-hoc, not a part of SMP protocol
 
       Resp "" _ (Msg mId2 msg2) <- tGet1 alice
       Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK mId2)
       Right ["reply_id", bId] <- pure $ B.words <$> aDec mId2 msg2
-      (bId, B64.encode (unEntityId bSnd)) #== "reply queue ID received from Bob"
+      (bId, B64.encode (SBS.fromShort $ unEntityId bSnd)) #== "reply queue ID received from Bob"
 
       (asPub, asKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
       Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, _SEND $ "key " <> strEncode asPub)
@@ -1161,9 +1162,9 @@ checkStats s qs sent received = do
   _msgSentNtf s `shouldBe` 0
   _msgRecvNtf s `shouldBe` 0
   let PeriodStatsData {_day, _week, _month} = _activeQueues s
-  IS.toList _day `shouldBe` map (hash . unEntityId) qs
-  IS.toList _week `shouldBe` map (hash . unEntityId) qs
-  IS.toList _month `shouldBe` map (hash . unEntityId) qs
+  IS.toList _day `shouldBe` map (hash . SBS.fromShort . unEntityId) qs
+  IS.toList _week `shouldBe` map (hash . SBS.fromShort . unEntityId) qs
+  IS.toList _month `shouldBe` map (hash . SBS.fromShort . unEntityId) qs
 
 testRestoreExpireMessages :: SpecWith (ASrvTransport, AStoreType)
 testRestoreExpireMessages =
@@ -1616,7 +1617,7 @@ testInvQueueLinkData =
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       C.CbNonce corrId <- atomically $ C.randomCbNonce g
-      let sId = EntityId $ B.take 24 $ C.sha3_384 corrId
+      let sId = EntityId $ SBS.toShort $ B.take 24 $ C.sha3_384 corrId
           ld = (EncDataBytes "fixed data", EncDataBytes "user data")
           qrd = QRMessaging $ Just (sId, ld)
       -- sender ID must be derived from corrId
@@ -1672,8 +1673,8 @@ testContactQueueLinkData =
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (dhPub, _dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       C.CbNonce corrId <- atomically $ C.randomCbNonce g
-      lnkId <- EntityId <$> atomically (C.randomBytes 24 g)
-      let sId = EntityId $ B.take 24 $ C.sha3_384 corrId
+      lnkId <- EntityId . SBS.toShort <$> atomically (C.randomBytes 24 g)
+      let sId = EntityId $ SBS.toShort $ B.take 24 $ C.sha3_384 corrId
           ld = (EncDataBytes "fixed data", EncDataBytes "user data")
           qrd = QRContact $ Just (lnkId, (sId, ld))
       -- sender ID must be derived from corrId
@@ -1711,7 +1712,7 @@ testContactQueueLinkData =
       sId4 `shouldBe` sId
       ld3 `shouldBe` newLD
 
-      badLnkId <- EntityId <$> atomically (C.randomBytes 24 g)
+      badLnkId <- EntityId . SBS.toShort <$> atomically (C.randomBytes 24 g)
       Resp "9" _ (ERR AUTH) <- signSendRecv r rKey ("9", rId, LSET badLnkId newLD)
 
       let badLD = (EncDataBytes "changed fixed data", EncDataBytes "updated user data 2")
@@ -1732,8 +1733,8 @@ testDuplicateQueueLinkData =
       (victimPub, victimKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
       (victimDhPub, _victimDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
       C.CbNonce corrId <- atomically $ C.randomCbNonce g
-      lnkId <- EntityId <$> atomically (C.randomBytes 24 g)
-      let victimSId = EntityId $ B.take 24 $ C.sha3_384 corrId
+      lnkId <- EntityId . SBS.toShort <$> atomically (C.randomBytes 24 g)
+      let victimSId = EntityId $ SBS.toShort $ B.take 24 $ C.sha3_384 corrId
           victimLD = (EncDataBytes "fixed data", EncDataBytes "victim user data")
           victimQRD = QRContact $ Just (lnkId, (victimSId, victimLD))
           victimReq = NEW (NewQueueReq victimPub victimDhPub Nothing SMSubscribe (Just victimQRD) Nothing)

tests/XFTPServerTests.hs

@@ -20,6 +20,7 @@ import Data.ByteString.Builder (byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.ByteString.Short as SBS
 import qualified Data.CaseInsensitive as CI
 import Data.List (find, isInfixOf)
 import Data.List.NonEmpty (NonEmpty)
@@ -104,7 +105,7 @@ createXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> FileInfo -> NonEmpty C.APu
 createXFTPChunk c spKey file rcps auth = (\(sId, rIds, _) -> (sId, rIds)) <$> A.createXFTPChunk c spKey file rcps auth Nothing
 
 readChunk :: XFTPFileId -> IO ByteString
-readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode $ unEntityId sId))
+readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode $ SBS.fromShort $ unEntityId sId))
 
 testFileChunkDelivery :: AFStoreType -> Expectation
 testFileChunkDelivery = xftpTest $ \c -> runRight_ $ runTestFileChunkDelivery c c