summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Channel.hs152
-rw-r--r--src/Identity.hs8
-rw-r--r--src/Main.hs6
-rw-r--r--src/Network.hs213
-rw-r--r--src/PubKey.hs36
5 files changed, 352 insertions, 63 deletions
diff --git a/src/Channel.hs b/src/Channel.hs
new file mode 100644
index 0000000..ee10e89
--- /dev/null
+++ b/src/Channel.hs
@@ -0,0 +1,152 @@
+module Channel (
+ Channel,
+ ChannelRequest, ChannelRequestData(..),
+ ChannelAccept, ChannelAcceptData(..),
+
+ createChannelRequest,
+ acceptChannelRequest,
+ acceptedChannel,
+
+ channelEncrypt,
+ channelDecrypt,
+) where
+
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.Fail
+
+import Crypto.Cipher.AES
+import Crypto.Cipher.Types
+import Crypto.Data.Padding
+import Crypto.Error
+import Crypto.Random
+
+import Data.ByteArray
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.List
+import qualified Data.Text as T
+
+import Identity
+import PubKey
+import Storage
+
+data Channel = Channel
+ { chPeers :: [Stored Identity]
+ , chKey :: ScrubbedBytes
+ }
+ deriving (Show)
+
+type ChannelRequest = Signed ChannelRequestData
+
+data ChannelRequestData = ChannelRequest
+ { crPeers :: [Stored Identity]
+ , crKey :: Stored PublicKexKey
+ }
+
+type ChannelAccept = Signed ChannelAcceptData
+
+data ChannelAcceptData = ChannelAccept
+ { caRequest :: Stored ChannelRequest
+ , caKey :: Stored PublicKexKey
+ }
+
+
+instance Storable Channel where
+ store' ch = storeRec $ do
+ mapM_ (storeRef "peer") $ chPeers ch
+ storeText "enc" $ T.pack "aes-128-gcm"
+ storeBinary "key" $ chKey ch
+
+ load' = loadRec $ do
+ enc <- loadText "enc"
+ guard $ enc == "aes-128-gcm"
+ Channel
+ <$> loadRefs "peer"
+ <*> loadBinary "key"
+
+instance Storable ChannelRequestData where
+ store' cr = storeRec $ do
+ mapM_ (storeRef "peer") $ crPeers cr
+ storeRef "key" $ crKey cr
+
+ load' = loadRec $ ChannelRequest
+ <$> loadRefs "peer"
+ <*> loadRef "key"
+
+instance Storable ChannelAcceptData where
+ store' ca = storeRec $ do
+ storeRef "req" $ caRequest ca
+ storeText "enc" $ T.pack "aes-128-gcm"
+ storeRef "key" $ caKey ca
+
+ load' = loadRec $ do
+ enc <- loadText "enc"
+ guard $ enc == "aes-128-gcm"
+ ChannelAccept
+ <$> loadRef "req"
+ <*> loadRef "key"
+
+
+createChannelRequest :: Stored Identity -> Stored Identity -> IO (Stored ChannelRequest)
+createChannelRequest self peer = do
+ let st = storedStorage self
+ (_, xpublic) <- generateKeys st
+ Just skey <- loadKey $ idKeyMessage $ fromStored $ signedData $ fromStored self
+ wrappedStore st =<< sign skey =<< wrappedStore st ChannelRequest { crPeers = sort [self, peer], crKey = xpublic }
+
+acceptChannelRequest :: Stored Identity -> Stored Identity -> Stored ChannelRequest -> ExceptT [String] IO (Stored ChannelAccept, Stored Channel)
+acceptChannelRequest self peer req = do
+ guard $ (crPeers $ fromStored $ signedData $ fromStored req) == sort [self, peer]
+ guard $ (idKeyMessage $ fromStored $ signedData $ fromStored peer) `elem` (map (sigKey . fromStored) $ signedSignature $ fromStored req)
+
+ let st = storedStorage self
+ KeySizeFixed ksize = cipherKeySize (undefined :: AES128)
+ liftIO $ do
+ (xsecret, xpublic) <- generateKeys st
+ Just skey <- loadKey $ idKeyMessage $ fromStored $ signedData $ fromStored self
+ acc <- wrappedStore st =<< sign skey =<< wrappedStore st ChannelAccept { caRequest = req, caKey = xpublic }
+ ch <- wrappedStore st Channel
+ { chPeers = crPeers $ fromStored $ signedData $ fromStored req
+ , chKey = BA.take ksize $ dhSecret xsecret $
+ fromStored $ crKey $ fromStored $ signedData $ fromStored req
+ }
+ return (acc, ch)
+
+acceptedChannel :: Stored Identity -> Stored Identity -> Stored ChannelAccept -> ExceptT [String] IO (Stored Channel)
+acceptedChannel self peer acc = do
+ let st = storedStorage self
+ req = caRequest $ fromStored $ signedData $ fromStored acc
+ KeySizeFixed ksize = cipherKeySize (undefined :: AES128)
+
+ guard $ (crPeers $ fromStored $ signedData $ fromStored req) == sort [self, peer]
+ guard $ (idKeyMessage $ fromStored $ signedData $ fromStored peer) `elem` (map (sigKey . fromStored) $ signedSignature $ fromStored acc)
+ guard $ (idKeyMessage $ fromStored $ signedData $ fromStored self) `elem` (map (sigKey . fromStored) $ signedSignature $ fromStored req)
+
+ Just xsecret <- liftIO $ loadKey $ crKey $ fromStored $ signedData $ fromStored req
+ liftIO $ wrappedStore st Channel
+ { chPeers = crPeers $ fromStored $ signedData $ fromStored req
+ , chKey = BA.take ksize $ dhSecret xsecret $
+ fromStored $ caKey $ fromStored $ signedData $ fromStored acc
+ }
+
+
+channelEncrypt :: (ByteArray ba, MonadRandom m, MonadFail m) => Channel -> ba -> m ba
+channelEncrypt ch plain = do
+ CryptoPassed (cipher :: AES128) <- return $ cipherInit $ chKey ch
+ let bsize = blockSize cipher
+ (iv :: ByteString) <- getRandomBytes bsize
+ CryptoPassed aead <- return $ aeadInit AEAD_GCM cipher iv
+ let (tag, ctext) = aeadSimpleEncrypt aead B.empty (pad (PKCS7 bsize) plain) bsize
+ return $ BA.concat [ convert iv, convert tag, ctext ]
+
+channelDecrypt :: (ByteArray ba, MonadFail m) => Channel -> ba -> m ba
+channelDecrypt ch body = do
+ CryptoPassed (cipher :: AES128) <- return $ cipherInit $ chKey ch
+ let bsize = blockSize cipher
+ (iv, body') = BA.splitAt bsize body
+ (tag, ctext) = BA.splitAt bsize body'
+ CryptoPassed aead <- return $ aeadInit AEAD_GCM cipher iv
+ Just plain <- return $ unpad (PKCS7 bsize) =<< aeadSimpleDecrypt aead B.empty ctext (AuthTag $ convert tag)
+ return plain
diff --git a/src/Identity.hs b/src/Identity.hs
index 07356d8..c1561b6 100644
--- a/src/Identity.hs
+++ b/src/Identity.hs
@@ -15,15 +15,17 @@ data IdentityData = Identity
, idPrev :: Maybe (Stored Identity)
, idOwner :: Maybe (Stored Identity)
, idKeyIdentity :: Stored PublicKey
+ , idKeyMessage :: Stored PublicKey
}
deriving (Show)
-emptyIdentity :: Stored PublicKey -> IdentityData
-emptyIdentity key = Identity
+emptyIdentity :: Stored PublicKey -> Stored PublicKey -> IdentityData
+emptyIdentity key kmsg = Identity
{ idName = Nothing
, idPrev = Nothing
, idOwner = Nothing
, idKeyIdentity = key
+ , idKeyMessage = kmsg
}
instance Storable IdentityData where
@@ -32,9 +34,11 @@ instance Storable IdentityData where
storeMbRef "prev" $ idPrev idt
storeMbRef "owner" $ idOwner idt
storeRef "key-id" $ idKeyIdentity idt
+ storeRef "key-msg" $ idKeyMessage idt
load' = loadRec $ Identity
<$> loadMbText "name"
<*> loadMbRef "prev"
<*> loadMbRef "owner"
<*> loadRef "key-id"
+ <*> loadRef "key-msg"
diff --git a/src/Main.hs b/src/Main.hs
index 40540fe..2a4dc4e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -26,11 +26,13 @@ main = do
name <- T.getLine
(secret, public) <- generateKeys st
+ (_secretMsg, publicMsg) <- generateKeys st
(devSecret, devPublic) <- generateKeys st
+ (_devSecretMsg, devPublicMsg) <- generateKeys st
- owner <- wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentity public) { idName = Just name }
+ owner <- wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentity public publicMsg) { idName = Just name }
base <- signAdd devSecret =<< sign secret =<<
- wrappedStore st (emptyIdentity devPublic) { idOwner = Just owner }
+ wrappedStore st (emptyIdentity devPublic devPublicMsg) { idOwner = Just owner }
Right h <- replaceHead base (Left (st, "identity"))
return h
diff --git a/src/Network.hs b/src/Network.hs
index f294835..1056265 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -11,12 +11,15 @@ import Control.Monad.Except
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
+import qualified Data.Map as M
import qualified Data.Text as T
import Network.Socket
import Network.Socket.ByteString (recvFrom, sendTo)
+import Channel
import Identity
+import PubKey
import Storage
@@ -25,8 +28,9 @@ discoveryPort = "29665"
data Peer = Peer
- { peerIdentity :: Stored Identity
- , peerAddress :: PeerAddress
+ { peerAddress :: PeerAddress
+ , peerIdentity :: Maybe (Stored Identity)
+ , peerChannels :: [Channel]
}
deriving (Show)
@@ -37,6 +41,8 @@ data PeerAddress = DatagramAddress SockAddr
data TransportHeader = AnnouncePacket Ref
| IdentityRequest Ref Ref
| IdentityResponse Ref
+ | TrChannelRequest Ref
+ | TrChannelAccept Ref
transportToObject :: TransportHeader -> Object
transportToObject = \case
@@ -53,6 +59,14 @@ transportToObject = \case
[ (BC.pack "TRANS", RecText $ T.pack "idresp")
, (BC.pack "identity", RecRef ref)
]
+ TrChannelRequest ref -> Rec
+ [ (BC.pack "TRANS", RecText $ T.pack "chreq")
+ , (BC.pack "req", RecRef ref)
+ ]
+ TrChannelAccept ref -> Rec
+ [ (BC.pack "TRANS", RecText $ T.pack "chacc")
+ , (BC.pack "acc", RecRef ref)
+ ]
transportFromObject :: Object -> Maybe TransportHeader
transportFromObject (Rec items)
@@ -69,71 +83,152 @@ transportFromObject (Rec items)
, Just (RecRef ref) <- lookup (BC.pack "identity") items
= Just $ IdentityResponse ref
+ | Just (RecText trans) <- lookup (BC.pack "TRANS") items, trans == T.pack "chreq"
+ , Just (RecRef ref) <- lookup (BC.pack "req") items
+ = Just $ TrChannelRequest ref
+
+ | Just (RecText trans) <- lookup (BC.pack "TRANS") items, trans == T.pack "chacc"
+ , Just (RecRef ref) <- lookup (BC.pack "acc") items
+ = Just $ TrChannelAccept ref
+
transportFromObject _ = Nothing
peerDiscovery :: String -> Stored Identity -> IO (Chan Peer)
peerDiscovery bhost sidentity = do
- chan <- newChan
+ chanPeer <- newChan
+ peers <- newMVar M.empty
+
+ let open addr = do
+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+ setSocketOption sock ReuseAddr 1
+ setSocketOption sock Broadcast 1
+ setCloseOnExecIfNeeded =<< fdSocket sock
+ bind sock (addrAddress addr)
+ return sock
+
+ loop sock = do
+ baddr:_ <- getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just bhost) (Just discoveryPort)
+ void $ sendTo sock (BL.toStrict $ serializeObject $ transportToObject $ AnnouncePacket $ storedRef sidentity) (addrAddress baddr)
+ forever $ do
+ (msg, paddr) <- recvFrom sock 4096
+ let packet' = packet sock paddr
+ case runExcept $ deserializeObjects (storedStorage sidentity) $ BL.fromStrict msg of
+ Left err -> putStrLn $ show paddr ++ ": " ++ err
+ Right (obj:objs) | Just tpack <- transportFromObject obj -> packet' tpack objs
+ _ -> putStrLn $ show paddr ++ ": invalid transport packet"
+
+ packet sock paddr (AnnouncePacket ref) _ = do
+ putStrLn $ "Got announce: " ++ show ref ++ " from " ++ show paddr
+ when (ref /= storedRef sidentity) $ void $ sendTo sock (BL.toStrict $ BL.concat
+ [ serializeObject $ transportToObject $ IdentityRequest ref (storedRef sidentity)
+ , BL.concat $ map (lazyLoadBytes . storedRef) $ collectStoredObjects $ wrappedLoad $ storedRef sidentity
+ ]) paddr
+
+ packet _ paddr (IdentityRequest ref from) [] = do
+ putStrLn $ "Got identity request: for " ++ show ref ++ " by " ++ show from ++ " from " ++ show paddr ++ " without content"
+
+ packet sock paddr (IdentityRequest ref from) (obj:objs) = do
+ putStrLn $ "Got identity request: for " ++ show ref ++ " by " ++ show from ++ " from " ++ show paddr
+ print (obj:objs)
+ from' <- store (storedStorage sidentity) obj
+ if from == from'
+ then do forM_ objs $ store $ storedStorage sidentity
+ let peer = Peer (DatagramAddress paddr) (Just $ wrappedLoad from) []
+ modifyMVar_ peers $ return . M.insert paddr peer
+ writeChan chanPeer peer
+ void $ sendTo sock (BL.toStrict $ BL.concat
+ [ serializeObject $ transportToObject $ IdentityResponse (storedRef sidentity)
+ , BL.concat $ map (lazyLoadBytes . storedRef) $ collectStoredObjects $ wrappedLoad $ storedRef sidentity
+ ]) paddr
+ else putStrLn $ "Mismatched content"
+
+ packet _ paddr (IdentityResponse ref) [] = do
+ putStrLn $ "Got identity response: by " ++ show ref ++ " from " ++ show paddr ++ " without content"
+
+ packet sock paddr (IdentityResponse ref) (obj:objs) = do
+ putStrLn $ "Got identity response: by " ++ show ref ++ " from " ++ show paddr
+ print (obj:objs)
+ ref' <- store (storedStorage sidentity) obj
+ if ref == ref'
+ then do forM_ objs $ store $ storedStorage sidentity
+ let pidentity = wrappedLoad ref
+ peer = Peer (DatagramAddress paddr) (Just pidentity) []
+ modifyMVar_ peers $ return . M.insert paddr peer
+ writeChan chanPeer peer
+ req <- createChannelRequest sidentity pidentity
+ void $ sendTo sock (BL.toStrict $ BL.concat
+ [ serializeObject $ transportToObject $ TrChannelRequest (storedRef req)
+ , lazyLoadBytes $ storedRef req
+ , lazyLoadBytes $ storedRef $ signedData $ fromStored req
+ , lazyLoadBytes $ storedRef $ crKey $ fromStored $ signedData $ fromStored req
+ , BL.concat $ map (lazyLoadBytes . storedRef) $ signedSignature $ fromStored req
+ ]) paddr
+ else putStrLn $ "Mismatched content"
+
+ packet _ paddr (TrChannelRequest _) [] = do
+ putStrLn $ "Got channel request: from " ++ show paddr ++ " without content"
+
+ packet sock paddr (TrChannelRequest ref) (obj:objs) = do
+ putStrLn $ "Got channel request: from " ++ show paddr
+ print (obj:objs)
+ ref' <- store (storedStorage sidentity) obj
+ if ref == ref'
+ then do forM_ objs $ store $ storedStorage sidentity
+ let request = wrappedLoad ref :: Stored ChannelRequest
+ modifyMVar_ peers $ \pval -> case M.lookup paddr pval of
+ Just peer | Just pid <- peerIdentity peer ->
+ runExceptT (acceptChannelRequest sidentity pid request) >>= \case
+ Left errs -> do mapM_ putStrLn ("Invalid channel request" : errs)
+ return pval
+ Right (acc, channel) -> do
+ putStrLn $ "Got channel: " ++ show (storedRef channel)
+ let peer' = peer { peerChannels = fromStored channel : peerChannels peer }
+ writeChan chanPeer peer'
+ void $ sendTo sock (BL.toStrict $ BL.concat
+ [ serializeObject $ transportToObject $ TrChannelAccept (storedRef acc)
+ , lazyLoadBytes $ storedRef acc
+ , lazyLoadBytes $ storedRef $ signedData $ fromStored acc
+ , lazyLoadBytes $ storedRef $ caKey $ fromStored $ signedData $ fromStored acc
+ , BL.concat $ map (lazyLoadBytes . storedRef) $ signedSignature $ fromStored acc
+ ]) paddr
+ return $ M.insert paddr peer' pval
+
+ _ -> do putStrLn $ "Invalid channel request - no peer identity"
+ return pval
+ else putStrLn $ "Mismatched content"
+
+ packet _ paddr (TrChannelAccept _) [] = do
+ putStrLn $ "Got channel accept: from " ++ show paddr ++ " without content"
+
+ packet _ paddr (TrChannelAccept ref) (obj:objs) = do
+ putStrLn $ "Got channel accept: from " ++ show paddr
+ print (obj:objs)
+ ref' <- store (storedStorage sidentity) obj
+ if ref == ref'
+ then do forM_ objs $ store $ storedStorage sidentity
+ let accepted = wrappedLoad ref :: Stored ChannelAccept
+ modifyMVar_ peers $ \pval -> case M.lookup paddr pval of
+ Just peer | Just pid <- peerIdentity peer ->
+ runExceptT (acceptedChannel sidentity pid accepted) >>= \case
+ Left errs -> do mapM_ putStrLn ("Invalid channel accept" : errs)
+ return pval
+ Right channel -> do
+ putStrLn $ "Got channel: " ++ show (storedRef channel)
+ let peer' = peer { peerChannels = fromStored channel : peerChannels peer }
+ writeChan chanPeer peer'
+ return $ M.insert paddr peer' pval
+ _ -> do putStrLn $ "Invalid channel accept - no peer identity"
+ return pval
+
+ else putStrLn $ "Mismatched content"
+
void $ forkIO $ withSocketsDo $ do
let hints = defaultHints
{ addrFlags = [AI_PASSIVE]
, addrSocketType = Datagram
}
addr:_ <- getAddrInfo (Just hints) Nothing (Just discoveryPort)
- bracket (open addr) close (loop chan)
- return chan
- where
- open addr = do
- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
- setSocketOption sock ReuseAddr 1
- setSocketOption sock Broadcast 1
- setCloseOnExecIfNeeded =<< fdSocket sock
- bind sock (addrAddress addr)
- return sock
-
- loop chan sock = do
- baddr:_ <- getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just bhost) (Just discoveryPort)
- void $ sendTo sock (BL.toStrict $ serializeObject $ transportToObject $ AnnouncePacket $ storedRef sidentity) (addrAddress baddr)
- forever $ do
- (msg, peer) <- recvFrom sock 4096
- let packet' = packet chan sock peer
- case runExcept $ deserializeObjects (storedStorage sidentity) $ BL.fromStrict msg of
- Left err -> putStrLn $ show peer ++ ": " ++ err
- Right (obj:objs) | Just tpack <- transportFromObject obj -> packet' tpack objs
- _ -> putStrLn $ show peer ++ ": invalid transport packet"
-
- packet _ sock peer (AnnouncePacket ref) _ = do
- putStrLn $ "Got announce: " ++ show ref ++ " from " ++ show peer
- when (ref /= storedRef sidentity) $ void $ sendTo sock (BL.toStrict $ BL.concat
- [ serializeObject $ transportToObject $ IdentityRequest ref (storedRef sidentity)
- , BL.concat $ map (lazyLoadBytes . storedRef) $ collectStoredObjects $ wrappedLoad $ storedRef sidentity
- ]) peer
-
- packet _ _ peer (IdentityRequest ref from) [] = do
- putStrLn $ "Got identity request: for " ++ show ref ++ " by " ++ show from ++ " from " ++ show peer ++ " without content"
-
- packet chan sock peer (IdentityRequest ref from) (obj:objs) = do
- putStrLn $ "Got identity request: for " ++ show ref ++ " by " ++ show from ++ " from " ++ show peer
- print (obj:objs)
- from' <- store (storedStorage sidentity) obj
- if from == from'
- then do forM_ objs $ store $ storedStorage sidentity
- writeChan chan $ Peer (wrappedLoad from) (DatagramAddress peer)
- void $ sendTo sock (BL.toStrict $ BL.concat
- [ serializeObject $ transportToObject $ IdentityResponse (storedRef sidentity)
- , BL.concat $ map (lazyLoadBytes . storedRef) $ collectStoredObjects $ wrappedLoad $ storedRef sidentity
- ]) peer
- else putStrLn $ "Mismatched content"
-
- packet _ _ peer (IdentityResponse ref) [] = do
- putStrLn $ "Got identity response: by " ++ show ref ++ " from " ++ show peer ++ " without content"
-
- packet chan _ peer (IdentityResponse ref) (obj:objs) = do
- putStrLn $ "Got identity response: by " ++ show ref ++ " from " ++ show peer
- print (obj:objs)
- ref' <- store (storedStorage sidentity) obj
- if ref == ref'
- then do forM_ objs $ store $ storedStorage sidentity
- writeChan chan $ Peer (wrappedLoad ref) (DatagramAddress peer)
- else putStrLn $ "Mismatched content"
+ bracket (open addr) close loop
+
+ return chanPeer
diff --git a/src/PubKey.hs b/src/PubKey.hs
index 0022343..6dc8080 100644
--- a/src/PubKey.hs
+++ b/src/PubKey.hs
@@ -3,6 +3,9 @@ module PubKey (
KeyPair(generateKeys), loadKey,
Signature(sigKey), Signed, signedData, signedSignature,
sign, signAdd,
+
+ PublicKexKey, SecretKexKey,
+ dhSecret,
) where
import Control.Monad
@@ -10,6 +13,7 @@ import Control.Monad.Except
import Crypto.Error
import qualified Crypto.PubKey.Ed25519 as ED
+import qualified Crypto.PubKey.Curve25519 as CX
import Data.ByteArray
import Data.ByteString (ByteString)
@@ -98,3 +102,35 @@ signAdd (SecretKey secret spublic) (Signed val sigs) = do
sig = ED.sign secret public $ storedRef val
ssig <- wrappedStore (storedStorage val) $ Signature spublic sig
return $ Signed val (ssig : sigs)
+
+
+data PublicKexKey = PublicKexKey CX.PublicKey
+ deriving (Show)
+
+data SecretKexKey = SecretKexKey CX.SecretKey (Stored PublicKexKey)
+
+instance KeyPair SecretKexKey PublicKexKey where
+ keyGetPublic (SecretKexKey _ pub) = pub
+ keyGetData (SecretKexKey sec _) = convert sec
+ keyFromData kdata spub = SecretKexKey <$> maybeCryptoError (CX.secretKey kdata) <*> pure spub
+ generateKeys st = do
+ secret <- CX.generateSecretKey
+ public <- wrappedStore st $ PublicKexKey $ CX.toPublic secret
+ let pair = SecretKexKey secret public
+ storeKey pair
+ return (pair, public)
+
+instance Storable PublicKexKey where
+ store' (PublicKexKey pk) = storeRec $ do
+ storeText "type" $ T.pack "x25519"
+ storeBinary "pubkey" pk
+
+ load' = loadRec $ do
+ ktype <- loadText "type"
+ guard $ ktype == "x25519"
+ maybe (throwError "public key decoding failed") (return . PublicKexKey) .
+ maybeCryptoError . (CX.publicKey :: ScrubbedBytes -> CryptoFailable CX.PublicKey) =<<
+ loadBinary "pubkey"
+
+dhSecret :: SecretKexKey -> PublicKexKey -> ScrubbedBytes
+dhSecret (SecretKexKey secret _) (PublicKexKey public) = convert $ CX.dh public secret