66.app-versions.3

Main.hs

@@ -0,0 +1,29 @@
+
+import qualified MagicWormhole.Internal.Versions as Versions
+import Data.Aeson.Types
+import Data.String (String)
+
+data InvitesVersion0 = InvitesVersion0 deriving (Eq, Show)
+
+instance ToJSON InvitesVersion0 where
+  toJSON InvitesVersion0 =
+    object ["magic-folder" .= object ["supported-messages" .= ["invite-v1" :: String]]]
+
+
+{-
+app_versions={
+     "magic-folder": {
+            "supported-messages": [
+                "invite-v1",
+            ],
+        },
+}
+-}
+
+
+main = do
+  let a = InvitesVersion0
+  let v = (Versions.Versions InvitesVersion0)
+  print $ toJSON a
+  print v
+  print $ toJSON v

cmd/HocusPocus.hs

@@ -11,6 +11,7 @@ import qualified Options.Applicative as Opt
 
 import qualified Crypto.Spake2 as Spake2
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as AesonKeyMap
 import qualified Data.Text as Text
 
 import qualified MagicWormhole
@@ -66,7 +67,7 @@ sendText session password message = do
   mailbox <- MagicWormhole.claim session nameplate
   peer <- MagicWormhole.open session mailbox  -- XXX: We should run `close` in the case of exceptions?
   let (MagicWormhole.Nameplate n) = nameplate
-  MagicWormhole.withEncryptedConnection peer (Spake2.makePassword (toS n <> "-" <> password))
+  MagicWormhole.withEncryptedConnection peer (Spake2.makePassword (toS n <> "-" <> password)) (Aeson.Object AesonKeyMap.empty)
     (\conn -> do
         let offer = MagicWormhole.Message message
         MagicWormhole.sendMessage conn (MagicWormhole.PlainText (toS (Aeson.encode offer))))
@@ -83,7 +84,7 @@ receiveText session = do
   putText "Password: "
   password <- getLine
   let fullPassword = toS nameplate <> "-" <> toS password
-  MagicWormhole.withEncryptedConnection peer (Spake2.makePassword fullPassword)
+  MagicWormhole.withEncryptedConnection peer (Spake2.makePassword fullPassword) (Aeson.Object AesonKeyMap.empty)
     (\conn -> do
         MagicWormhole.PlainText received <- atomically $ MagicWormhole.receiveMessage conn
         case Aeson.eitherDecode (toS received) of
@@ -108,11 +109,11 @@ bounce endpoint appID = do
       (_, output) <- concurrently (send peer1 message) (receive peer2)
       unless (output == message) $ panic $ "Mismatched messages: " <> show message <> " != " <> show output
   where
-    send peer message = MagicWormhole.withEncryptedConnection peer password $ \conn -> do
+    send peer message = MagicWormhole.withEncryptedConnection peer password (Aeson.Object AesonKeyMap.empty) $ \conn -> do
       let offer = MagicWormhole.Message message
       MagicWormhole.sendMessage conn (MagicWormhole.PlainText (toS (Aeson.encode offer)))
 
-    receive peer = MagicWormhole.withEncryptedConnection peer password $ \conn -> do
+    receive peer = MagicWormhole.withEncryptedConnection peer password (Aeson.Object AesonKeyMap.empty) $ \conn -> do
       MagicWormhole.PlainText received <- atomically $ MagicWormhole.receiveMessage conn
       case Aeson.eitherDecode (toS received) of
         Left err -> panic $ "Could not decode message: " <> show err

package.yaml

@@ -25,7 +25,7 @@ default-extensions:
 
 dependencies:
   - base >= 4.6 && < 5
-  - protolude >= 0.3.0 && < 0.4
+  - protolude
 
 library:
   source-dirs: src
@@ -38,7 +38,7 @@ library:
     - memory
     - network
     - network-uri
-    - saltine >= 0.2.0.0
+    - saltine
     - spake2 >= 0.4.3
     - stm
     - unordered-containers
@@ -54,6 +54,7 @@ executables:
       - optparse-applicative
       - spake2 >= 0.4.3
       - text
+      - unordered-containers
 
 tests:
   tasty:
@@ -66,14 +67,15 @@ tests:
       - magic-wormhole
       - memory
       - process
-      - saltine >= 0.2.0.0
+      - saltine
       - spake2 >= 0.4.3
       - stm
       - tasty
       - tasty-hedgehog
-      - hspec >= 2.8.3 && <3.0
-      - tasty-hspec >= 1.2 && <2.0
-      - hspec-expectations >= 0.8.1 && <1.0
+      - hspec
+      - tasty-hspec
+      - hspec-expectations
+      - unordered-containers
 
 # These are only for tests.
 data-files:

src/MagicWormhole.hs

@@ -38,6 +38,7 @@ module MagicWormhole
   , WebSockets.parseWebSocketEndpoint
     -- ** Operations on the server
   , Rendezvous.allocate
+  , Rendezvous.release
   , Messages.Nameplate(..)
   , Rendezvous.list
   , Rendezvous.claim

src/MagicWormhole/Internal/ClientProtocol.hs

@@ -27,7 +27,7 @@ import Protolude.Conv (toS)
 
 import Crypto.Hash (SHA256(..), hashWith)
 import qualified Crypto.KDF.HKDF as HKDF
-import qualified Crypto.Saltine.Internal.SecretBox as Bytes
+import qualified Crypto.Saltine.Internal.ByteSizes as Bytes
 import qualified Crypto.Saltine.Class as Saltine
 import qualified Crypto.Saltine.Core.SecretBox as SecretBox
 import qualified Data.ByteArray as ByteArray
@@ -106,7 +106,7 @@ decryptMessage key message =
 -- Encrypted using 'encrypt'.
 decrypt :: SecretBox.Key -> CipherText -> Either PeerError PlainText
 decrypt key (CipherText ciphertext) = do
-  let (nonce', ciphertext') = ByteString.splitAt Bytes.secretbox_noncebytes ciphertext
+  let (nonce', ciphertext') = ByteString.splitAt Bytes.secretBoxNonce ciphertext
   nonce <- note (InvalidNonce nonce') $ Saltine.decode nonce'
   note (CouldNotDecrypt ciphertext') $ PlainText <$> SecretBox.secretboxOpen key nonce ciphertext'
 
@@ -131,7 +131,7 @@ deriveKey (SessionKey key) purpose =
     Saltine.decode (HKDF.expand (HKDF.extract salt key :: HKDF.PRK SHA256) purpose keySize)
   where
     salt = "" :: ByteString
-    keySize = Bytes.secretbox_keybytes
+    keySize = Bytes.secretBoxKey
 
 -- | Obtain a 'Purpose' for deriving a key to send a message that's part of a
 -- peer-to-peer communication.

src/MagicWormhole/Internal/Peer.hs

@@ -20,13 +20,16 @@ import Control.Concurrent.STM.TVar
   )
 import qualified Crypto.Saltine.Core.SecretBox as SecretBox
 import qualified Crypto.Spake2 as Spake2
+import Data.Aeson (ToJSON, FromJSON)
+
+import Data.Aeson (FromJSON, ToJSON)
 
 import qualified MagicWormhole.Internal.ClientProtocol as ClientProtocol
 import qualified MagicWormhole.Internal.Messages as Messages
 import qualified MagicWormhole.Internal.Pake as Pake
 import qualified MagicWormhole.Internal.Sequential as Sequential
 import qualified MagicWormhole.Internal.Versions as Versions
-
+import qualified MagicWormhole.Internal.Rendezvous as Rendezvous
 
 -- XXX: Lots of duplicated code sending JSON data. Either make a typeclass for
 -- this sort of thing or at least sendJSON, receiveJSON.
@@ -39,10 +42,10 @@ import qualified MagicWormhole.Internal.Versions as Versions
 -- | Establish an encrypted connection between peers.
 --
 -- Use this connection with 'withEncryptedConnection'.
-establishEncryption :: ClientProtocol.Connection -> Spake2.Password -> IO EncryptedConnection
-establishEncryption peer password = do
+establishEncryption :: (FromJSON a, ToJSON a, Eq a) => ClientProtocol.Connection -> Spake2.Password -> a -> IO EncryptedConnection
+establishEncryption peer password appversion = do
   key <- Pake.pakeExchange peer password
-  void $ Versions.versionExchange peer key
+  void $ Versions.versionExchange peer key appversion
   liftIO $ atomically $ newEncryptedConnection peer key
 
 -- | Run an action that communicates with a Magic Wormhole peer through an
@@ -58,12 +61,14 @@ establishEncryption peer password = do
 --   * 'Pake.PakeError', when SPAKE2 cryptography fails
 --   * 'Versions.VersionsError', when we cannot agree on shared capabilities (this can sometimes imply SPAKE2 cryptography failure)
 withEncryptedConnection
-  :: ClientProtocol.Connection  -- ^ Underlying to a peer. Get this with 'Rendezvous.open'.
+  :: (Eq b, FromJSON b, ToJSON b)
+  => ClientProtocol.Connection  -- ^ Underlying to a peer. Get this with 'Rendezvous.open'.
   -> Spake2.Password  -- ^ The shared password that is the basis of the encryption. Construct with 'Spake2.makePassword'.
+  -> b -- ^ a Aeson encodable type that represent the app version.
   -> (EncryptedConnection -> IO a)  -- ^ Action to perform with the encrypted connection.
   -> IO a  -- ^ The result of the action
-withEncryptedConnection peer password action = do
-  conn <- establishEncryption peer password
+withEncryptedConnection peer password appversion action = do
+  conn <- establishEncryption peer password appversion
   runEncryptedConnection conn (action conn)
 
 -- | A Magic Wormhole peer-to-peer application session.
@@ -86,6 +91,7 @@ data EncryptedConnection
   , outbound :: TVar Int
   }
 
+
 -- | Construct a new encrypted connection.
 newEncryptedConnection :: ClientProtocol.Connection -> ClientProtocol.SessionKey -> STM EncryptedConnection
 newEncryptedConnection conn sessionKey = EncryptedConnection conn sessionKey <$> Sequential.sequenceBy getAppRank firstPhase <*> newTVar firstPhase