Skip to content

Commit 53b7246

Browse files
epoberezkinepoberezkin
authored
refactor types (#1551)
1 parent f80ed32 commit 53b7246

File tree

17 files changed

+87
-72
lines changed

17 files changed

+87
-72
lines changed

‎src/Simplex/FileTransfer/Client.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ import Simplex.Messaging.Protocol
5656
SenderId,
5757
pattern NoEntity,
5858
)
59-
import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
59+
import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
6060
import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
6161
import Simplex.Messaging.Transport.HTTP2
6262
import Simplex.Messaging.Transport.HTTP2.Client
@@ -147,12 +147,12 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
147147
Nothing -> throwE $ PCETransportError TEVersion
148148
Just (Compatible vr) ->
149149
fmap (vr,) . liftTransportErr (TEHandshake BAD_AUTH) $ do
150-
let (X.CertificateChain cert, exact) = serverAuth
150+
let CertChainPubKey (X.CertificateChain cert) exact = serverAuth
151151
case cert of
152152
[_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
153153
_ -> throwError "bad certificate"
154154
pubKey <- maybe (throwError "bad server key type") (`C.verifyX509` exact) serverKey
155-
C.x509ToPublic (pubKey, []) >>= C.pubKey
155+
C.x509ToPublic' pubKey
156156
sendClientHandshake :: XFTPClientHandshake -> ExceptT XFTPClientError IO ()
157157
sendClientHandshake chs = do
158158
chs' <- liftTransportErr TELargeMsg $ C.pad (smpEncode chs) xftpBlockSize

‎src/Simplex/FileTransfer/Server.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatu
6161
import Simplex.Messaging.Server.Stats
6262
import Simplex.Messaging.TMap (TMap)
6363
import qualified Simplex.Messaging.TMap as TM
64-
import Simplex.Messaging.Transport (ALPN, SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
64+
import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
6565
import Simplex.Messaging.Transport.Buffer (trimCR)
6666
import Simplex.Messaging.Transport.HTTP2
6767
import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
@@ -110,7 +110,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
110110
runServer :: M ()
111111
runServer = do
112112
srvCreds@(chain, pk) <- asks tlsServerCreds
113-
signKey <- liftIO $ case C.x509ToPrivate (pk, []) >>= C.privKey of
113+
signKey <- liftIO $ case C.x509ToPrivate' pk of
114114
Right pk' -> pure pk'
115115
Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
116116
env <- ask
@@ -142,7 +142,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
142142
unless (B.null bodyHead) $ throwE HANDSHAKE
143143
(k, pk) <- atomically . C.generateKeyPair =<< asks random
144144
atomically $ TM.insert sessionId (HandshakeSent pk) sessions
145-
let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
145+
let authPubKey = CertChainPubKey chain (C.signX509 serverSignKey $ C.publicToX509 k)
146146
let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
147147
shs <- encodeXftp hs
148148
#ifdef slow_servers

‎src/Simplex/FileTransfer/Transport.hs‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -42,23 +42,22 @@ import Control.Monad.IO.Class
4242
import Control.Monad.Trans.Except
4343
import qualified Data.Aeson.TH as J
4444
import qualified Data.Attoparsec.ByteString.Char8 as A
45-
import Data.Bifunctor (bimap, first)
45+
import Data.Bifunctor (first)
4646
import qualified Data.ByteArray as BA
4747
import Data.ByteString.Builder (Builder, byteString)
4848
import Data.ByteString.Char8 (ByteString)
4949
import qualified Data.ByteString.Char8 as B
5050
import qualified Data.ByteString.Lazy.Char8 as LB
5151
import Data.Functor (($>))
5252
import Data.Word (Word16, Word32)
53-
import qualified Data.X509 as X
5453
import Network.HTTP2.Client (HTTP2Error)
5554
import qualified Simplex.Messaging.Crypto as C
5655
import qualified Simplex.Messaging.Crypto.Lazy as LC
5756
import Simplex.Messaging.Encoding
5857
import Simplex.Messaging.Encoding.String
5958
import Simplex.Messaging.Parsers
6059
import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
61-
import Simplex.Messaging.Transport (ALPN, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
60+
import Simplex.Messaging.Transport (ALPN, CertChainPubKey, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
6261
import Simplex.Messaging.Transport.HTTP2.File
6362
import Simplex.Messaging.Util (bshow, tshow)
6463
import Simplex.Messaging.Version
@@ -112,7 +111,7 @@ data XFTPServerHandshake = XFTPServerHandshake
112111
{ xftpVersionRange :: VersionRangeXFTP,
113112
sessionId :: SessionId,
114113
-- | pub key to agree shared secrets for command authorization and entity ID encryption.
115-
authPubKey :: (X.CertificateChain, X.SignedExact X.PubKey)
114+
authPubKey :: CertChainPubKey
116115
}
117116

118117
data XFTPClientHandshake = XFTPClientHandshake
@@ -132,15 +131,12 @@ instance Encoding XFTPClientHandshake where
132131

133132
instance Encoding XFTPServerHandshake where
134133
smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey} =
135-
smpEncode (xftpVersionRange, sessionId, auth)
136-
where
137-
auth = bimap C.encodeCertChain C.SignedObject authPubKey
134+
smpEncode (xftpVersionRange, sessionId, authPubKey)
138135
smpP = do
139136
(xftpVersionRange, sessionId) <- smpP
140-
cert <- C.certChainP
141-
C.SignedObject key <- smpP
137+
authPubKey <- smpP
142138
Tail _compat <- smpP
143-
pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey = (cert, key)}
139+
pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey}
144140

145141
sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
146142
sendEncFile h send = go

‎src/Simplex/Messaging/Client.hs‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -956,7 +956,7 @@ connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT S
956956
connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, tcpTimeout}} relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth
957957
| thVersion (thParams c) >= sendingProxySMPVersion =
958958
sendProtocolCommand_ c Nothing tOut Nothing NoEntity (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
959-
PKEY sId vr (chain, key) ->
959+
PKEY sId vr (CertChainPubKey chain key) ->
960960
case supportedClientSMPRelayVRange `compatibleVersion` vr of
961961
Nothing -> throwE $ transportErr TEVersion
962962
Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v proxyAuth <$> validateRelay chain key
@@ -970,10 +970,9 @@ connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, t
970970
serverKey <- case cert of
971971
[leaf, ca]
972972
| XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 ->
973-
C.x509ToPublic (X.certPubKey . X.signedObject $ X.getSigned leaf, []) >>= C.pubKey
973+
C.x509ToPublic' $ X.certPubKey $ X.signedObject $ X.getSigned leaf
974974
_ -> throwError "bad certificate"
975-
pubKey <- C.verifyX509 serverKey exact
976-
C.x509ToPublic (pubKey, []) >>= C.pubKey
975+
C.x509ToPublic' =<< C.verifyX509 serverKey exact
977976

978977
data ProxiedRelay = ProxiedRelay
979978
{ prSessionId :: SessionId,

‎src/Simplex/Messaging/Crypto.hs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,7 @@ module Simplex.Messaging.Crypto
6464
AAuthKeyPair,
6565
KeyPair,
6666
KeyPairX25519,
67+
KeyPairEd25519,
6768
ASignatureKeyPair,
6869
DhSecret (..),
6970
DhSecretX25519,
@@ -78,7 +79,9 @@ module Simplex.Messaging.Crypto
7879
generateDhKeyPair,
7980
privateToX509,
8081
x509ToPublic,
82+
x509ToPublic',
8183
x509ToPrivate,
84+
x509ToPrivate',
8285
publicKey,
8386
signatureKeyPair,
8487
publicToX509,
@@ -678,6 +681,8 @@ type KeyPair a = KeyPairType (PrivateKey a)
678681

679682
type KeyPairX25519 = KeyPair X25519
680683

684+
type KeyPairEd25519 = KeyPair Ed25519
685+
681686
-- TODO narrow key pair types to have the same algorithm in both keys
682687
type AKeyPair = KeyPairType APrivateKey
683688

@@ -1484,6 +1489,10 @@ x509ToPublic = \case
14841489
(X.PubKeyX448 k, []) -> Right . APublicKey SX448 $ PublicKeyX448 k
14851490
r -> keyError r
14861491

1492+
x509ToPublic' :: CryptoPublicKey k => X.PubKey -> Either String k
1493+
x509ToPublic' k = x509ToPublic (k, []) >>= pubKey
1494+
{-# INLINE x509ToPublic' #-}
1495+
14871496
x509ToPrivate :: (X.PrivKey, [ASN1]) -> Either String APrivateKey
14881497
x509ToPrivate = \case
14891498
(X.PrivKeyEd25519 k, []) -> Right . APrivateKey SEd25519 . PrivateKeyEd25519 k $ Ed25519.toPublic k
@@ -1492,6 +1501,10 @@ x509ToPrivate = \case
14921501
(X.PrivKeyX448 k, []) -> Right . APrivateKey SX448 . PrivateKeyX448 k $ X448.toPublic k
14931502
r -> keyError r
14941503

1504+
x509ToPrivate' :: CryptoPrivateKey k => X.PrivKey -> Either String k
1505+
x509ToPrivate' pk = x509ToPrivate (pk, []) >>= privKey
1506+
{-# INLINE x509ToPrivate' #-}
1507+
14951508
decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
14961509
decodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict
14971510

‎src/Simplex/Messaging/Crypto/ShortLink.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ contactShortLinkKdf (LinkKey k) =
4848
invShortLinkKdf :: LinkKey -> C.SbKey
4949
invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
5050

51-
encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPair 'C.Ed25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> ConnInfo -> (LinkKey, (ByteString, ByteString))
51+
encodeSignLinkData :: forall c. ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> ConnInfo -> (LinkKey, (ByteString, ByteString))
5252
encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
5353
let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq}
5454
md = smpEncode $ connLinkData @c agentVRange userData

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -123,10 +123,9 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
123123
runServer :: (ServiceName, ASrvTransport, AddHTTP) -> M ()
124124
runServer (tcpPort, ATransport t, _addHTTP) = do
125125
srvCreds <- asks tlsServerCreds
126-
serverSignKey <- either fail pure $ fromTLSCredentials srvCreds
126+
serverSignKey <- either fail pure $ C.x509ToPrivate' $ snd srvCreds
127127
env <- ask
128128
liftIO $ runTransportServer started tcpPort defaultSupportedParams srvCreds (Just supportedNTFHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
129-
fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
130129

131130
runClient :: Transport c => C.APrivateSignKey -> TProxy c 'TServer -> c 'TServer -> M ()
132131
runClient signKey _ h = do

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -55,14 +55,14 @@ data NtfTknData = NtfTknData
5555
token :: DeviceToken,
5656
tknStatus :: TVar NtfTknStatus,
5757
tknVerifyKey :: NtfPublicAuthKey,
58-
tknDhKeys :: C.KeyPair 'C.X25519,
58+
tknDhKeys :: C.KeyPairX25519,
5959
tknDhSecret :: C.DhSecretX25519,
6060
tknRegCode :: NtfRegCode,
6161
tknCronInterval :: TVar Word16,
6262
tknUpdatedAt :: TVar (Maybe RoundedSystemTime)
6363
}
6464

65-
mkNtfTknData :: NtfTokenId -> NewNtfEntity 'Token -> C.KeyPair 'C.X25519 -> C.DhSecretX25519 -> NtfRegCode -> RoundedSystemTime -> IO NtfTknData
65+
mkNtfTknData :: NtfTokenId -> NewNtfEntity 'Token -> C.KeyPairX25519 -> C.DhSecretX25519 -> NtfRegCode -> RoundedSystemTime -> IO NtfTknData
6666
mkNtfTknData ntfTknId (NewNtfTkn token tknVerifyKey _) tknDhKeys tknDhSecret tknRegCode ts = do
6767
tknStatus <- newTVarIO NTRegistered
6868
tknCronInterval <- newTVarIO 0

‎src/Simplex/Messaging/Notifications/Transport.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ ntfClientHandshake c keyHash ntfVRange _proxyServer = do
137137
ck_ <- forM sk' $ \signedKey -> liftEitherWith (const $ TEHandshake BAD_AUTH) $ do
138138
serverKey <- getServerVerifyKey c
139139
pubKey <- C.verifyX509 serverKey signedKey
140-
(,(getPeerCertChain c, signedKey)) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
140+
(,CertChainPubKey (getPeerCertChain c) signedKey) <$> C.x509ToPublic' pubKey
141141
let v = maxVersion vr
142142
sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash}
143143
pure $ ntfThHandleClient th v vr ck_
@@ -148,7 +148,7 @@ ntfThHandleServer th v vr pk =
148148
let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
149149
in ntfThHandle_ th v vr (Just thAuth)
150150

151-
ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> VersionRangeNTF -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleNTF c 'TClient
151+
ntfThHandleClient :: forall c. THandleNTF c 'TClient -> VersionNTF -> VersionRangeNTF -> Maybe (C.PublicKeyX25519, CertChainPubKey) -> THandleNTF c 'TClient
152152
ntfThHandleClient th v vr ck_ =
153153
let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = ck, sessSecret = Nothing}) <$> ck_
154154
in ntfThHandle_ th v vr thAuth

‎src/Simplex/Messaging/Notifications/Types.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ data NtfToken = NtfToken
5252
-- | key used by the ntf client to sign transmissions
5353
ntfPrivKey :: C.APrivateAuthKey,
5454
-- | client's DH keys (to repeat registration if necessary)
55-
ntfDhKeys :: C.KeyPair 'C.X25519,
55+
ntfDhKeys :: C.KeyPairX25519,
5656
-- | shared DH secret used to encrypt/decrypt notifications e2e
5757
ntfDhSecret :: Maybe C.DhSecretX25519,
5858
-- | token status
@@ -63,7 +63,7 @@ data NtfToken = NtfToken
6363
}
6464
deriving (Show)
6565

66-
newNtfToken :: DeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPair 'C.X25519 -> NotificationsMode -> NtfToken
66+
newNtfToken :: DeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPairX25519 -> NotificationsMode -> NtfToken
6767
newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode =
6868
NtfToken
6969
{ deviceToken,

0 commit comments

Comments
 (0)