hwormhole 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+54/−49 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- hwormhole.cabal +4/−4
- src/Transit/Internal/FileTransfer.hs +45/−45
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for haskell-magic-wormhole-client +## 0.2.0.0 -- 2018-12-12++* Fix a bug which shows up as a failed hwormhole to hwormhole transfer,+ at the same time works fine with python magic-wormhole client.+ ## 0.1.0.0 -- 2018-12-10 * First version of the haskell port of magic-wormhole client.
hwormhole.cabal view
@@ -2,14 +2,14 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/ name: hwormhole-version: 0.1.0.0+version: 0.2.0.0 synopsis: magic-wormhole client description: A secure way to send files over the Internet using the magic-wormhole protocol license: GPL-3 license-file: LICENSE-author: Ramakrishnan Muthukrishnan-maintainer: ram@leastauthority.com-copyright: (c) 2018 Least Authority TFA Gmbh+author: Ramakrishnan Muthukrishnan <ram@leastauthority.com>, Jean-Paul Calderone <jean-paul@leastauthority.com>+maintainer: Least Authority TFA GmbH+copyright: (c) 2018 Least Authority TFA GmbH category: Network build-type: Simple extra-source-files: ChangeLog.md
src/Transit/Internal/FileTransfer.hs view
@@ -92,8 +92,8 @@ | otherwise -> return $ Left (NetworkError (TransitError "transit ack failure")) Left s -> return $ Left (NetworkError (TransitError (toS ("transit ack failure: " <> s)))) -establishSenderTransit :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> IO (Either Error TransitEndpoint)-establishSenderTransit conn transitserver appid = do+establishSenderTransit :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> FilePath -> IO (Either Error TransitEndpoint)+establishSenderTransit conn transitserver appid filepath = do -- exchange abilities sock' <- tcpListener portnum <- socketPort sock'@@ -104,28 +104,33 @@ case transitResp of Left s -> return $ Left (NetworkError s) Right (Transit _peerAbilities peerHints) -> do- -- combine our relay hints with peer's direct and relay hints- let allHints = Set.toList $ ourRelayHints <> peerHints- -- concurrently start client and server- transitEndpoint <- race (startServer sock') (startClient allHints)- let ep = either identity identity transitEndpoint- case ep of- Left e -> return (Left (NetworkError e))- Right endpoint -> do- -- 0. derive transit key- let transitKey = MagicWormhole.deriveKey conn (transitPurpose appid)- -- 1. create record keys- recordKeys = makeRecordKeys transitKey- case recordKeys of- Left e -> return (Left (CipherError e))- Right (sRecordKey, rRecordKey) -> do- -- 2. handshakeExchange- handshake <- senderHandshakeExchange endpoint transitKey side- -- if handshakeExchange is successful, return the TCPEndpoint- -- as, we now have a "secure" socket to communicate.- case handshake of- Left e -> return (Left (HandshakeError e))- Right _ -> return $ Right (TransitEndpoint endpoint sRecordKey rRecordKey)+ -- send offer for the file+ offerResp <- senderOfferExchange conn filepath+ case offerResp of+ Left s -> return (Left (NetworkError (OfferError s)))+ Right _ -> do+ -- combine our relay hints with peer's direct and relay hints+ let allHints = Set.toList $ ourRelayHints <> peerHints+ -- concurrently start client and server+ transitEndpoint <- race (startServer sock') (startClient allHints)+ let ep = either identity identity transitEndpoint+ case ep of+ Left e -> return (Left (NetworkError e))+ Right endpoint -> do+ -- 0. derive transit key+ let transitKey = MagicWormhole.deriveKey conn (transitPurpose appid)+ -- 1. create record keys+ recordKeys = makeRecordKeys transitKey+ case recordKeys of+ Left e -> return (Left (CipherError e))+ Right (sRecordKey, rRecordKey) -> do+ -- 2. handshakeExchange+ handshake <- senderHandshakeExchange endpoint transitKey side+ -- if handshakeExchange is successful, return the TCPEndpoint+ -- as, we now have a "secure" socket to communicate.+ case handshake of+ Left e -> return (Left (HandshakeError e))+ Right _ -> return $ Right (TransitEndpoint endpoint sRecordKey rRecordKey) Right _ -> return $ Left (NetworkError (UnknownPeerMessage "Could not decode message")) establishReceiverTransit :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> TransitMsg -> Socket -> IO (Either Error TransitEndpoint)@@ -164,30 +169,25 @@ sendFile :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> FilePath -> IO (Either Error ()) sendFile conn transitserver appid filepath = do -- establish a transit connection- endpoint <- establishSenderTransit conn transitserver appid+ endpoint <- establishSenderTransit conn transitserver appid filepath case endpoint of Left e -> return $ Left e Right ep -> do- -- send offer for the file- offerResp <- senderOfferExchange conn filepath- case offerResp of- Left s -> return (Left (NetworkError (OfferError s)))- Right pathToSend -> do- (rxAckMsg, txSha256Hash) <-- finally- (do -- send encrypted records to the peer- (txSha256Hash, _) <- C.runConduitRes (sendPipeline pathToSend ep)- -- read a record that should contain the transit Ack.- -- If ack is not ok or the sha256sum is incorrect, flag an error.- rxAckMsg <- receiveAckMessage ep- return (rxAckMsg, txSha256Hash))- (closeConnection ep)- case rxAckMsg of- Right rxSha256Hash ->- if txSha256Hash /= rxSha256Hash- then return $ Left (NetworkError (Sha256SumError "sha256 mismatch"))- else return (Right ())- Left e -> return $ Left e+ (rxAckMsg, txSha256Hash) <-+ finally+ (do -- send encrypted records to the peer+ (txSha256Hash, _) <- C.runConduitRes (sendPipeline filepath ep)+ -- read a record that should contain the transit Ack.+ -- If ack is not ok or the sha256sum is incorrect, flag an error.+ rxAckMsg <- receiveAckMessage ep+ return (rxAckMsg, txSha256Hash))+ (closeConnection ep)+ case rxAckMsg of+ Right rxSha256Hash ->+ if txSha256Hash /= rxSha256Hash+ then return $ Left (NetworkError (Sha256SumError "sha256 mismatch"))+ else return (Right ())+ Left e -> return $ Left e -- | Receive a file or directory via the established MagicWormhole connection receiveFile :: MagicWormhole.EncryptedConnection -> RelayEndpoint -> MagicWormhole.AppID -> TransitMsg -> IO (Either Error ())