From c27b3c23ecdd53acdbfece747b9bbdb39bf4dae9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 27 Aug 2023 18:33:16 +0200
Subject: Replace storedStorage usage with MonadHead

---
 src/Channel.hs | 23 ++++++++++-------------
 1 file changed, 10 insertions(+), 13 deletions(-)

(limited to 'src/Channel.hs')

diff --git a/src/Channel.hs b/src/Channel.hs
index a1773bd..167c1ba 100644
--- a/src/Channel.hs
+++ b/src/Channel.hs
@@ -77,13 +77,13 @@ instance Storable ChannelAcceptData where
 keySize :: Int
 keySize = 32
 
-createChannelRequest :: (MonadIO m) => Storage -> UnifiedIdentity -> UnifiedIdentity -> m (Stored ChannelRequest)
-createChannelRequest st self peer = liftIO $ do
-    (_, xpublic) <- generateKeys st
-    Just skey <- loadKey $ idKeyMessage self
-    wrappedStore st =<< sign skey =<< wrappedStore st ChannelRequest { crPeers = sort [idData self, idData peer], crKey = xpublic }
+createChannelRequest :: (MonadStorage m, MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> m (Stored ChannelRequest)
+createChannelRequest self peer = do
+    (_, xpublic) <- liftIO . generateKeys =<< getStorage
+    skey <- loadKey $ idKeyMessage self
+    mstore =<< sign skey =<< mstore ChannelRequest { crPeers = sort [idData self, idData peer], crKey = xpublic }
 
-acceptChannelRequest :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Channel)
+acceptChannelRequest :: (MonadStorage m, MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Channel)
 acceptChannelRequest self peer req = do
     case sequence $ map validateIdentity $ crPeers $ fromStored $ signedData $ fromStored req of
         Nothing -> throwError $ "invalid peers in channel request"
@@ -95,11 +95,10 @@ acceptChannelRequest self peer req = do
     when (idKeyMessage peer `notElem` (map (sigKey . fromStored) $ signedSignature $ fromStored req)) $
         throwError $ "channel requent not signed by peer"
 
-    let st = storedStorage req
+    (xsecret, xpublic) <- liftIO . generateKeys =<< getStorage
+    skey <- loadKey $ idKeyMessage self
+    acc <- mstore =<< sign skey =<< mstore ChannelAccept { caRequest = req, caKey = xpublic }
     liftIO $ do
-        (xsecret, xpublic) <- generateKeys st
-        Just skey <- loadKey $ idKeyMessage self
-        acc <- wrappedStore st =<< sign skey =<< wrappedStore st ChannelAccept { caRequest = req, caKey = xpublic }
         let chPeers = crPeers $ fromStored $ signedData $ fromStored req
             chKey = BA.take keySize $ dhSecret xsecret $
                 fromStored $ crKey $ fromStored $ signedData $ fromStored req
@@ -125,9 +124,7 @@ acceptedChannel self peer acc = do
     when (idKeyMessage self `notElem` (map (sigKey . fromStored) $ signedSignature $ fromStored req)) $
         throwError $ "original channel request not signed by us"
 
-    xsecret <- liftIO (loadKey $ crKey $ fromStored $ signedData $ fromStored req) >>= \case
-        Just key -> return key
-        Nothing  -> throwError $ "secret key not found"
+    xsecret <- loadKey $ crKey $ fromStored $ signedData $ fromStored req
     let chPeers = crPeers $ fromStored $ signedData $ fromStored req
         chKey = BA.take keySize $ dhSecret xsecret $
             fromStored $ caKey $ fromStored $ signedData $ fromStored acc
-- 
cgit v1.2.3