diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-27 18:33:16 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-30 20:53:55 +0200 |
| commit | c27b3c23ecdd53acdbfece747b9bbdb39bf4dae9 (patch) | |
| tree | 52a4be70840e2691195ec54149f5ac14ec112606 /src/Attach.hs | |
| parent | dfddb65ad1abf5ba4171be42d303850ebbc363ee (diff) | |
Replace storedStorage usage with MonadHead
Diffstat (limited to 'src/Attach.hs')
| -rw-r--r-- | src/Attach.hs | 20 |
1 files changed, 9 insertions, 11 deletions
diff --git a/src/Attach.hs b/src/Attach.hs index 67828aa..48d18d8 100644 --- a/src/Attach.hs +++ b/src/Attach.hs @@ -42,9 +42,8 @@ instance PairingResult AttachIdentity where pairingVerifyResult (AttachIdentity sdata keys) = do curid <- lsIdentity . fromStored <$> svcGetLocal - secret <- maybe (throwError "failed to load own secret key") return =<< - liftIO (loadKey $ iddKeyIdentity $ fromStored $ signedData $ fromStored curid) - sdata' <- liftIO $ wrappedStore (storedStorage sdata) =<< signAdd secret (fromStored sdata) + secret <- loadKey $ iddKeyIdentity $ fromStored $ signedData $ fromStored curid + sdata' <- mstore =<< signAdd secret (fromStored sdata) return $ do guard $ iddKeyIdentity (fromStored $ signedData $ fromStored sdata) == iddKeyIdentity (fromStored $ signedData $ fromStored curid) @@ -52,26 +51,25 @@ instance PairingResult AttachIdentity where guard $ iddPrev (fromStored $ signedData $ fromStored $ idData identity) == [curid] return (identity, keys) - pairingFinalizeRequest (identity, keys) = updateLocalHead_ $ \slocal -> liftIO $ do + pairingFinalizeRequest (identity, keys) = updateLocalHead_ $ \slocal -> do let owner = finalOwner identity - st = storedStorage slocal + st <- getStorage pkeys <- mapM (copyStored st) [ idKeyIdentity owner, idKeyMessage owner ] - mapM_ storeKey $ catMaybes [ keyFromData sec pub | sec <- keys, pub <- pkeys ] + liftIO $ mapM_ storeKey $ catMaybes [ keyFromData sec pub | sec <- keys, pub <- pkeys ] shared <- makeSharedStateUpdate st (Just owner) (lsShared $ fromStored slocal) - wrappedStore st (fromStored slocal) + mstore (fromStored slocal) { lsIdentity = idData identity , lsShared = [ shared ] } pairingFinalizeResponse = do - st <- storedStorage <$> svcGetLocal owner <- mergeSharedIdentity pid <- asks svcPeerIdentity - secret <- maybe (throwError "failed to load secret key") return =<< liftIO (loadKey $ idKeyIdentity owner) - identity <- liftIO $ wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentityData $ idKeyIdentity pid) + secret <- loadKey $ idKeyIdentity owner + identity <- mstore =<< sign secret =<< mstore (emptyIdentityData $ idKeyIdentity pid) { iddPrev = [idData pid], iddOwner = Just (idData owner) } - skeys <- liftIO $ map keyGetData . catMaybes <$> mapM loadKey [ idKeyIdentity owner, idKeyMessage owner ] + skeys <- map keyGetData . catMaybes <$> mapM loadKeyMb [ idKeyIdentity owner, idKeyMessage owner ] return $ AttachIdentity identity skeys defaultPairingAttributes _ = PairingAttributes |