Channel: use counter to generate nonce

3 files changed, 35 insertions, 35 deletions

diff --git a/erebos.cabal b/erebos.cabal
index 277fa4a..bf091d1 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -60,6 +60,7 @@ executable erebos
   -- other-extensions:
   build-depends:       aeson >=1.4 && <1.6,
                        base >=4.13 && <4.15,
+                       binary >=0.8 && <0.9,
                        bytestring >=0.10 && <0.12,
                        cereal >= 0.5 && <0.6,
                        containers >= 0.6 && <0.7,
diff --git a/src/Channel.hs b/src/Channel.hs
index ad88190..625d526 100644
--- a/src/Channel.hs
+++ b/src/Channel.hs
@@ -11,20 +11,21 @@ module Channel (
     channelDecrypt,
 ) where
 
+import Control.Concurrent.MVar
 import Control.Monad
 import Control.Monad.Except
 
 import Crypto.Cipher.AES
 import Crypto.Cipher.Types
 import Crypto.Error
-import Crypto.Random
 
+import Data.Binary
 import Data.ByteArray
-import qualified Data.ByteArray as BA
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
+import Data.ByteArray qualified as BA
+import Data.ByteString qualified as B
+import Data.ByteString.Lazy qualified as BL
 import Data.List
-import qualified Data.Text as T
+import Data.Text qualified as T
 
 import Identity
 import PubKey
@@ -33,8 +34,10 @@ import Storage
 data Channel = Channel
     { chPeers :: [Stored (Signed IdentityData)]
     , chKey :: ScrubbedBytes
+    , chNonceFixedOur :: Bytes
+    , chNonceFixedPeer :: Bytes
+    , chNonceCounter :: MVar Word64
     }
-    deriving (Show)
 
 type ChannelRequest = Signed ChannelRequestData
 
@@ -52,19 +55,6 @@ data ChannelAcceptData = ChannelAccept
     }
 
 
-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
@@ -98,7 +88,7 @@ createChannelRequest st self peer = liftIO $ do
     Just skey <- loadKey $ idKeyMessage self
     wrappedStore st =<< sign skey =<< wrappedStore st ChannelRequest { crPeers = sort [idData self, idData peer], crKey = xpublic }
 
-acceptChannelRequest :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Stored Channel)
+acceptChannelRequest :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Channel)
 acceptChannelRequest self peer req = do
     when ((crPeers $ fromStored $ signedData $ fromStored req) /= sort (map idData [self, peer])) $
         throwError $ "mismatched peers in channel request"
@@ -111,17 +101,19 @@ acceptChannelRequest self peer req = do
         (xsecret, xpublic) <- generateKeys st
         Just skey <- loadKey $ idKeyMessage self
         acc <- wrappedStore st =<< sign skey =<< wrappedStore st ChannelAccept { caRequest = req, caKey = xpublic }
-        ch <- wrappedStore st Channel
+        counter <- newMVar 0
+        return $ (acc,) $ Channel
             { chPeers = crPeers $ fromStored $ signedData $ fromStored req
             , chKey = BA.take ksize $ dhSecret xsecret $
                 fromStored $ crKey $ fromStored $ signedData $ fromStored req
+            , chNonceFixedOur  = BA.pack [ 2, 0, 0, 0, 0, 0 ]
+            , chNonceFixedPeer = BA.pack [ 1, 0, 0, 0, 0, 0 ]
+            , chNonceCounter = counter
             }
-        return (acc, ch)
 
-acceptedChannel :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelAccept -> m (Stored Channel)
+acceptedChannel :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelAccept -> m Channel
 acceptedChannel self peer acc = do
-    let st = storedStorage acc
-        req = caRequest $ fromStored $ signedData $ fromStored acc
+    let req = caRequest $ fromStored $ signedData $ fromStored acc
         KeySizeFixed ksize = cipherKeySize (undefined :: AES128)
 
     when ((crPeers $ fromStored $ signedData $ fromStored req) /= sort (map idData [self, peer])) $
@@ -134,10 +126,14 @@ acceptedChannel self peer acc = do
     xsecret <- liftIO (loadKey $ crKey $ fromStored $ signedData $ fromStored req) >>= \case
         Just key -> return key
         Nothing  -> throwError $ "secret key not found"
-    liftIO $ wrappedStore st Channel
+    counter <- liftIO $ newMVar 0
+    return $ Channel
         { chPeers = crPeers $ fromStored $ signedData $ fromStored req
         , chKey = BA.take ksize $ dhSecret xsecret $
             fromStored $ caKey $ fromStored $ signedData $ fromStored acc
+        , chNonceFixedOur  = BA.pack [ 1, 0, 0, 0, 0, 0 ]
+        , chNonceFixedPeer = BA.pack [ 2, 0, 0, 0, 0, 0 ]
+        , chNonceCounter = counter
         }
 
 
@@ -147,12 +143,14 @@ channelEncrypt ch plain = do
                    CryptoPassed (cipher :: AES128) -> return cipher
                    _ -> throwError "failed to init AES128 cipher"
     let bsize = blockSize cipher
-    (iv :: ByteString) <- liftIO $ getRandomBytes 12
+    count <- liftIO $ modifyMVar (chNonceCounter ch) $ \c -> return (c + 1, c)
+    let cbytes = convert $ BL.toStrict $ BL.drop 2 $ encode count
+        iv = chNonceFixedOur ch `append` cbytes
     aead <- case aeadInit AEAD_GCM cipher iv of
                  CryptoPassed aead -> return aead
                  _ -> throwError "failed to init AEAD_GCM"
     let (tag, ctext) = aeadSimpleEncrypt aead B.empty plain bsize
-    return $ BA.concat [ convert iv, ctext, convert tag ]
+    return $ BA.concat [ BA.pack [ 0, 0 ], convert cbytes, ctext, convert tag ]
 
 channelDecrypt :: (ByteArray ba, MonadError String m) => Channel -> ba -> m ba
 channelDecrypt ch body = do
@@ -160,7 +158,8 @@ channelDecrypt ch body = do
                    CryptoPassed (cipher :: AES128) -> return cipher
                    _ -> throwError "failed to init AES128 cipher"
     let bsize = blockSize cipher
-        (iv, body') = BA.splitAt 12 body
+        (cbytes, body') = BA.splitAt 8 body
+        iv = chNonceFixedPeer ch `append` convert (BA.drop 2 cbytes)
         (ctext, tag) = BA.splitAt (BA.length body' - bsize) body'
     aead <- case aeadInit AEAD_GCM cipher iv of
                  CryptoPassed aead -> return aead
diff --git a/src/Network.hs b/src/Network.hs
index e27c2a3..e78ae7c 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -138,7 +138,7 @@ data PeerIdentity = PeerIdentityUnknown (TVar [UnifiedIdentity -> ExceptT String
 data PeerChannel = ChannelWait
                  | ChannelOurRequest (Stored ChannelRequest)
                  | ChannelPeerRequest WaitingRef
-                 | ChannelOurAccept (Stored ChannelAccept) (Stored Channel)
+                 | ChannelOurAccept (Stored ChannelAccept) Channel
                  | ChannelEstablished Channel
 
 peerIdentity :: MonadIO m => Peer -> m PeerIdentity
@@ -328,9 +328,9 @@ startServer opt origHead logd' services = do
                     case M.lookup paddr pvalue of
                         Just peer -> do
                             mbch <- atomically (readTVar (peerChannel peer)) >>= return . \case
-                                ChannelEstablished ch  -> Just ch
-                                ChannelOurAccept _ sch -> Just $ fromStored sch
-                                _                      -> Nothing
+                                ChannelEstablished ch -> Just ch
+                                ChannelOurAccept _ ch -> Just ch
+                                _                     -> Nothing
 
                             if  | Just ch <- mbch
                                 , Right plain <- runExcept $ channelDecrypt ch msg
@@ -492,7 +492,7 @@ handlePacket origHead identity secure peer chanSvc svcs (TransportHeader headers
             Acknowledged ref -> do
                 readTVarP (peerChannel peer) >>= \case
                     ChannelOurAccept acc ch | refDigest (storedRef acc) == refDigest ref -> do
-                        writeTVarP (peerChannel peer) $ ChannelEstablished (fromStored ch)
+                        writeTVarP (peerChannel peer) $ ChannelEstablished ch
                         liftSTM $ finalizedChannel peer origHead identity
                     _ -> return ()
 
@@ -630,7 +630,7 @@ handleChannelAccept oh identity accref = do
                     ch <- acceptedChannel identity upid (wrappedLoad acc)
                     liftIO $ atomically $ do
                         sendToPeerS peer $ TransportPacket (TransportHeader [Acknowledged accref]) []
-                        writeTVar (peerChannel peer) $ ChannelEstablished $ fromStored ch
+                        writeTVar (peerChannel peer) $ ChannelEstablished ch
                         finalizedChannel peer oh identity
 
                 Left dgst -> throwError $ "missing accept data " ++ BC.unpack (showRefDigest dgst)