magic-wormhole-0.3.1: Interact with Magic Wormhole

Safe HaskellNone
LanguageHaskell2010

MagicWormhole

Contents

Description

Magic Wormhole is a technology for getting things from one computer to another, safely.

To use it, you must

  1. Start a Session with the Rendezvous server, to allow peers to find each other (runClient)
  2. Negotiate a shared Nameplate so peers can find each other on the server (allocate, list)
  3. Use the shared Nameplate to open a shared Mailbox
  4. Use a secret password shared between peers to establish an encrypted connection (withEncryptedConnection)

Once you've done this, you can communicate with your peer via sendMessage and receiveMessage.

The password is never sent over the wire. Rather, it is used to negotiate a session key using SPAKE2, and that key itself is used to derive many per-message keys, so that each message is encrypted using NaCl SecretBox.

This library is a client library for the Rendezvous server and a library for communicating with Magic Wormhole peers.

Synopsis

Client/server

Before you can communicate with a Magic Wormhole peer, you must first find them. The way to do this is to establish a Session with a Magic Wormhole Rendezvous server.

Establishing a session

data Session Source #

Abstract type representing a Magic Wormhole session.

Use runClient to get a Session on the Magic Wormhole Rendezvous server. Once you have a Session, use ping, list, allocate, claim, release, open, and close to communicate with the Rendezvous server.

runClient Source #

Arguments

:: HasCallStack 
=> WebSocketEndpoint

The websocket to connect to

-> AppID

ID for your application (e.g. example.com/your-application)

-> Side

Identifier for your side

-> Maybe Socket

Just an existing socket to use or Nothing to create and use a new one

-> (Session -> IO a)

Action to perform inside the Magic Wormhole session

-> IO a

The result of the action

Run a Magic Wormhole Rendezvous client. Use this to interact with a Magic Wormhole server.

Will throw a ServerError if the server declares we are unwelcome.

newtype AppID Source #

Short string to identify the application. Clients must use the same application ID if they wish to communicate with each other.

Recommendation is to use "$DNSNAME/$APPNAME", e.g. the Python wormhole command-line tool uses lothar.com/wormhole/text-or-file-xfer.

Constructors

AppID Text 
Instances
Eq AppID Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

(==) :: AppID -> AppID -> Bool

(/=) :: AppID -> AppID -> Bool

Show AppID Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

showsPrec :: Int -> AppID -> ShowS

show :: AppID -> String

showList :: [AppID] -> ShowS

FromJSON AppID Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

parseJSON :: Value -> Parser AppID

parseJSONList :: Value -> Parser [AppID]

ToJSON AppID Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

toJSON :: AppID -> Value

toEncoding :: AppID -> Encoding

toJSONList :: [AppID] -> Value

toEncodingList :: [AppID] -> Encoding

newtype Side Source #

Short string used to differentiate between echoes of our own messages and real messages from other clients.

TODO: This needs to be cleanly encoded to ASCII, so update the type or provide a smart constructor.

Constructors

Side Text 
Instances
Eq Side Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

(==) :: Side -> Side -> Bool

(/=) :: Side -> Side -> Bool

Show Side Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

showsPrec :: Int -> Side -> ShowS

show :: Side -> String

showList :: [Side] -> ShowS

FromJSON Side Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

parseJSON :: Value -> Parser Side

parseJSONList :: Value -> Parser [Side]

ToJSON Side Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

toJSON :: Side -> Value

toEncoding :: Side -> Encoding

toJSONList :: [Side] -> Value

toEncodingList :: [Side] -> Encoding

generateSide :: MonadRandom randomly => randomly Side Source #

Generate a random Side

Locating the server

Rendezvous servers are implemented as web sockets.

data WebSocketEndpoint Source #

Endpoint for a websocket connection.

Construct directly or with parseWebSocketEndpoint.

Instances
Eq WebSocketEndpoint Source # 
Instance details

Defined in MagicWormhole.Internal.WebSockets

Show WebSocketEndpoint Source # 
Instance details

Defined in MagicWormhole.Internal.WebSockets

Methods

showsPrec :: Int -> WebSocketEndpoint -> ShowS

show :: WebSocketEndpoint -> String

showList :: [WebSocketEndpoint] -> ShowS

Operations on the server

allocate :: HasCallStack => Session -> IO Nameplate Source #

Allocate a nameplate on the server.

Throws a ClientError if the server rejects the message for any reason.

newtype Nameplate Source #

Identifier for a "nameplate".

A nameplate is a very short string that identifies one peer to another. Its purpose is to allow peers to find each other without having to communicate the Mailbox identifier, which is generally too lengthy and cumbersome to be easily shared between humans.

Typically, one peer will allocate a nameplate and then communicate it out-of-band to the other peer.

Constructors

Nameplate Text 
Instances
Eq Nameplate Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

(==) :: Nameplate -> Nameplate -> Bool

(/=) :: Nameplate -> Nameplate -> Bool

Show Nameplate Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

showsPrec :: Int -> Nameplate -> ShowS

show :: Nameplate -> String

showList :: [Nameplate] -> ShowS

FromJSON Nameplate Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

parseJSON :: Value -> Parser Nameplate

parseJSONList :: Value -> Parser [Nameplate]

ToJSON Nameplate Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

toJSON :: Nameplate -> Value

toEncoding :: Nameplate -> Encoding

toJSONList :: [Nameplate] -> Value

toEncodingList :: [Nameplate] -> Encoding

list :: HasCallStack => Session -> IO [Nameplate] Source #

List the nameplates on the server.

Throws a ClientError if the server rejects the message for any reason.

claim :: HasCallStack => Session -> Nameplate -> IO Mailbox Source #

Claim a nameplate on the server.

Throws a ClientError if the server rejects the message for any reason.

newtype Mailbox Source #

Identifier for a mailbox.

A mailbox is a shared access point between Magic Wormhole peers within the same application (specified by AppID). To get a mailbox, you must first acquire a Nameplate and then claim that nameplate for your side with claim.

A mailbox ID is defined in the spec as a "large random string", but in practice is a 13 character, lower-case, alpha-numeric string.

Constructors

Mailbox Text 
Instances
Eq Mailbox Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

(==) :: Mailbox -> Mailbox -> Bool

(/=) :: Mailbox -> Mailbox -> Bool

Show Mailbox Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

showsPrec :: Int -> Mailbox -> ShowS

show :: Mailbox -> String

showList :: [Mailbox] -> ShowS

FromJSON Mailbox Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

parseJSON :: Value -> Parser Mailbox

parseJSONList :: Value -> Parser [Mailbox]

ToJSON Mailbox Source # 
Instance details

Defined in MagicWormhole.Internal.Messages

Methods

toJSON :: Mailbox -> Value

toEncoding :: Mailbox -> Encoding

toJSONList :: [Mailbox] -> Value

toEncodingList :: [Mailbox] -> Encoding

open :: HasCallStack => Session -> Mailbox -> IO Connection Source #

Open a mailbox on the server.

If there's already a mailbox open, the server will send an error message. In the current implementation, that error will arise in a strange and unexpected place.

See https://github.com/warner/magic-wormhole/issues/261#issuecomment-343192449

close :: HasCallStack => Session -> Maybe Mailbox -> Maybe Mood -> IO () Source #

Close a mailbox on the server.

Throws a ClientError if the server rejects the message for any reason.

Errors

data ServerError Source #

Error due to weirdness from the server.

Constructors

ResponseWithoutRequest ServerMessage

Server sent us a response for something that we hadn't requested.

UnexpectedMessage ServerMessage

We were sent a message other than Welcome on connect, or a Welcome message at any other time.

ErrorForNonRequest Text ClientMessage

We received an error message for a message that's not expected to have a response.

Unwelcome Text

Clients are not welcome on the server right now.

ParseError String

We couldn't understand the message from the server.

Instances
Eq ServerError Source # 
Instance details

Defined in MagicWormhole.Internal.Rendezvous

Methods

(==) :: ServerError -> ServerError -> Bool

(/=) :: ServerError -> ServerError -> Bool

Show ServerError Source # 
Instance details

Defined in MagicWormhole.Internal.Rendezvous

Methods

showsPrec :: Int -> ServerError -> ShowS

show :: ServerError -> String

showList :: [ServerError] -> ShowS

Exception ServerError Source # 
Instance details

Defined in MagicWormhole.Internal.Rendezvous

Methods

toException :: ServerError -> SomeException

fromException :: SomeException -> Maybe ServerError

displayException :: ServerError -> String

data ClientError Source #

Error caused by misusing the client.

Constructors

AlreadySent ClientMessage

We tried to do an RPC while another RPC with the same response type was in flight. See warner/magic-wormhole#260 for details.

NotAnRPC ClientMessage

Tried to send a non-RPC as if it were an RPC (i.e. expecting a response).

BadRequest Text ClientMessage

We sent a message that the server could not understand.

Instances
Eq ClientError Source # 
Instance details

Defined in MagicWormhole.Internal.Rendezvous

Methods

(==) :: ClientError -> ClientError -> Bool

(/=) :: ClientError -> ClientError -> Bool

Show ClientError Source # 
Instance details

Defined in MagicWormhole.Internal.Rendezvous

Methods

showsPrec :: Int -> ClientError -> ShowS

show :: ClientError -> String

showList :: [ClientError] -> ShowS

Exception ClientError Source # 
Instance details

Defined in MagicWormhole.Internal.Rendezvous

Methods

toException :: ClientError -> SomeException

fromException :: SomeException -> Maybe ClientError

displayException :: ClientError -> String

Peer-to-peer

Opening a Mailbox shared with a peer gets you a Connection, but this is not enough to securely communicate with a peer. The next step is to establish an EncryptedConnection (via -- withEncryptedConnection), and then communicate with sendMessage and receiveMessage.

Establishing a secure connection

withEncryptedConnection Source #

Arguments

:: Connection

Underlying to a peer. Get this with open.

-> Password

The shared password that is the basis of the encryption. Construct with makePassword.

-> (EncryptedConnection -> IO a)

Action to perform with the encrypted connection.

-> IO a

The result of the action

Run an action that communicates with a Magic Wormhole peer through an encrypted connection.

Does the "pake" and "version" exchanges necessary to negotiate an encrypted connection and then runs the user-provided action. This action can then use sendMessage and receiveMessage to send & receive messages from its peer.

Can throw:

  • PeerError, when we receive nonsensical data from the other peer
  • PakeError, when SPAKE2 cryptography fails
  • VersionsError, when we cannot agree on shared capabilities (this can sometimes imply SPAKE2 cryptography failure)

data Connection Source #

A connection to a peer via the Rendezvous server.

Normally construct this with open.

data EncryptedConnection Source #

A Magic Wormhole peer-to-peer application session.

Construct one of these using withEncryptedConnection.

You get one of these after you have found a peer, successfully negotatiated a shared key, and verified that negotiation by exchanging versions. (Note that this does not include the "verifying" step mentioned in magic-wormhole's documentation, which is about a human being verifying the correctness of the code).

All messages in this session, sent & received, are encrypted using keys derived from this shared key.

deriveKey :: EncryptedConnection -> Purpose -> Key Source #

Derive a new key for the given purpose

Construct a new key from the encrypted connection's session key for the given purpose

Errors

data PeerError Source #

Something that went wrong with the client protocol.

Instances
Eq PeerError Source # 
Instance details

Defined in MagicWormhole.Internal.ClientProtocol

Methods

(==) :: PeerError -> PeerError -> Bool

(/=) :: PeerError -> PeerError -> Bool

Show PeerError Source # 
Instance details

Defined in MagicWormhole.Internal.ClientProtocol

Methods

showsPrec :: Int -> PeerError -> ShowS

show :: PeerError -> String

showList :: [PeerError] -> ShowS

Exception PeerError Source # 
Instance details

Defined in MagicWormhole.Internal.ClientProtocol

Methods

toException :: PeerError -> SomeException

fromException :: SomeException -> Maybe PeerError

displayException :: PeerError -> String

data VersionsError Source #

An error occurred during versionExchange.

Instances
Eq VersionsError Source # 
Instance details

Defined in MagicWormhole.Internal.Versions

Show VersionsError Source # 
Instance details

Defined in MagicWormhole.Internal.Versions

Methods

showsPrec :: Int -> VersionsError -> ShowS

show :: VersionsError -> String

showList :: [VersionsError] -> ShowS

Exception VersionsError Source # 
Instance details

Defined in MagicWormhole.Internal.Versions

Methods

toException :: VersionsError -> SomeException

fromException :: SomeException -> Maybe VersionsError

displayException :: VersionsError -> String

data PakeError Source #

An error that occured during pakeExchange.

Instances
Eq PakeError Source # 
Instance details

Defined in MagicWormhole.Internal.Pake

Methods

(==) :: PakeError -> PakeError -> Bool

(/=) :: PakeError -> PakeError -> Bool

Show PakeError Source # 
Instance details

Defined in MagicWormhole.Internal.Pake

Methods

showsPrec :: Int -> PakeError -> ShowS

show :: PakeError -> String

showList :: [PakeError] -> ShowS

Exception PakeError Source # 
Instance details

Defined in MagicWormhole.Internal.Pake

Methods

toException :: PakeError -> SomeException

fromException :: SomeException -> Maybe PakeError

displayException :: PakeError -> String

Communicating with a peer

sendMessage :: EncryptedConnection -> PlainText -> IO () Source #

Send an encrypted message to the peer.

Obtain an EncryptedConnection with withEncryptedConnection.

The message will be encrypted using a one-off key deriving from the shared key.

receiveMessage :: EncryptedConnection -> STM PlainText Source #

Receive a decrypted message from the peer.

Obtain an EncryptedConnection with withEncryptedConnection.

newtype PlainText Source #

Unencrypted text.

Constructors

PlainText 

Fields

Instances
Eq PlainText Source # 
Instance details

Defined in MagicWormhole.Internal.ClientProtocol

Methods

(==) :: PlainText -> PlainText -> Bool

(/=) :: PlainText -> PlainText -> Bool

Ord PlainText Source # 
Instance details

Defined in MagicWormhole.Internal.ClientProtocol

Methods

compare :: PlainText -> PlainText -> Ordering

(<) :: PlainText -> PlainText -> Bool

(<=) :: PlainText -> PlainText -> Bool

(>) :: PlainText -> PlainText -> Bool

(>=) :: PlainText -> PlainText -> Bool

max :: PlainText -> PlainText -> PlainText

min :: PlainText -> PlainText -> PlainText

Show PlainText Source # 
Instance details

Defined in MagicWormhole.Internal.ClientProtocol

Methods

showsPrec :: Int -> PlainText -> ShowS

show :: PlainText -> String

showList :: [PlainText] -> ShowS

Magic Wormhole applications

Once you've established an EncryptedConnection to your peer, the world is your oyster. You can send whatever data you'd like.

However, Magic Wormhole comes with at least one built-in "application": message and file transfer. This Haskell implementation only supports sending and receiving a simple message.

data Offer Source #

An offer made by a sender as part of the Magic Wormhole file transfer protocol.

Currently only supports sending simple text messages. A full version would also support sending files and directories.

Constructors

Message Text

A simple text message.

File FilePath FileOffset

Offer a File with filename and size.

Directory

Offer a Directory

Fields

  • directoryMode :: DirectoryMode

    Mode. Currently always "zipfile/deflated".

  • dirName :: Text

    Directory Name.

  • zipSize :: Natural

    size of the transmitted compressed data in bytes

  • numBytes :: Natural

    estimated total size of the uncompressed directory

  • numFiles :: Natural

    number of files and directories being sent

Instances
Eq Offer Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

(==) :: Offer -> Offer -> Bool

(/=) :: Offer -> Offer -> Bool

Show Offer Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

showsPrec :: Int -> Offer -> ShowS

show :: Offer -> String

showList :: [Offer] -> ShowS

FromJSON Offer Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

parseJSON :: Value -> Parser Offer

parseJSONList :: Value -> Parser [Offer]

ToJSON Offer Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

toJSON :: Offer -> Value

toEncoding :: Offer -> Encoding

toJSONList :: [Offer] -> Value

toEncodingList :: [Offer] -> Encoding

data DirectoryMode Source #

Textual representation of the format in which the directory tree is encoded

Constructors

ZipFileDeflated 
Instances
Eq DirectoryMode Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Show DirectoryMode Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

showsPrec :: Int -> DirectoryMode -> ShowS

show :: DirectoryMode -> String

showList :: [DirectoryMode] -> ShowS

FromJSON DirectoryMode Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

parseJSON :: Value -> Parser DirectoryMode

parseJSONList :: Value -> Parser [DirectoryMode]

ToJSON DirectoryMode Source # 
Instance details

Defined in MagicWormhole.Internal.FileTransfer

Methods

toJSON :: DirectoryMode -> Value

toEncoding :: DirectoryMode -> Encoding

toJSONList :: [DirectoryMode] -> Value

toEncodingList :: [DirectoryMode] -> Encoding