diff --git a/src/Futr.hs b/src/Futr.hs index c7aefb8..52349de 100644 --- a/src/Futr.hs +++ b/src/Futr.hs @@ -257,8 +257,8 @@ parseNprofileOrNpub input = -- | Login with an account. loginWithAccount :: FutrEff es => ObjRef () -> PKeyMgmt.Account -> Eff es Bool loginWithAccount obj a = do - modify @AppState $ \s -> s { keyPair = Just (secKeyToKeyPair $ PKeyMgmt.nsec a) } - let (rs, _) = PKeyMgmt.relays a + modify @AppState $ \s -> s { keyPair = Just (secKeyToKeyPair $ PKeyMgmt.accountNsec a) } + let (rs, _) = PKeyMgmt.accountRelays a -- add general relays --modify @AppState $ \st -> st { generalRelays = (rs, t) } -- add all relays to the relay pool diff --git a/src/Main.hs b/src/Main.hs index ec72e96..0512fed 100755 --- a/src/Main.hs +++ b/src/Main.hs @@ -50,16 +50,16 @@ main = do . runConcurrent -- nostr related . runNostr + . KeyMgmt.runKeyMgmt . runWebSocket 3 -- max 3 retries . runGiftWrap . runPublishManager . runSubscription . runRelayPool . runOutboxModel + . RelayMgmt.runRelayMgmt -- presentation related - . KeyMgmt.runKeyMgmt . KeyMgmt.runKeyMgmtUI - . RelayMgmt.runRelayMgmt . RelayMgmt.runRelayMgmtUI -- run futr . Futr.runFutr diff --git a/src/Nostr/OutboxModel.hs b/src/Nostr/OutboxModel.hs index fb077a6..b847bbd 100644 --- a/src/Nostr/OutboxModel.hs +++ b/src/Nostr/OutboxModel.hs @@ -15,10 +15,12 @@ import Effectful.Dispatch.Dynamic import Effectful.State.Static.Shared import Effectful.TH +import Nostr.Bech32 (pubKeyXOToBech32) import Nostr.Keys (PubKeyXO, keyPairToPubKeyXO) import Nostr.RelayPool qualified as RP import Nostr.Types (Kind(..), Event(..), Relay(..), RelayURI, Response(..), eventFilter, getUri) import Nostr.Util +import Presentation.KeyMgmt (KeyMgmt, updateRelays, AccountId(..)) import Types (AppState(..), OutboxModelState(..), PublishStatus(..)) @@ -50,6 +52,7 @@ type OutboxModelEff es = , State AppState :> es , Util :> es , Concurrent :> es + , KeyMgmt :> es ) runOutboxModel :: OutboxModelEff es => Eff (OutboxModel : es) a -> Eff es a @@ -65,13 +68,17 @@ runOutboxModel = interpret $ \_ -> \case (True, False) -> InboxRelay relay' (False, True) -> OutboxRelay relay' (False, False) -> error "Unreachable due to guard above" + let newRelays = ([relay''], timestamp) modify $ \st -> st - { generalRelays = Map.insertWith keepMostRecent pk ([relay''], timestamp) (generalRelays st) } + { generalRelays = Map.insertWith keepMostRecent pk newRelays (generalRelays st) } + updateRelays (AccountId $ pubKeyXOToBech32 pk) newRelays return True RemoveGeneralRelay pk r -> do modify $ \st -> st { generalRelays = Map.adjust (removeAllRelayTypes r) pk (generalRelays st) } + updatedRelays <- gets (Map.findWithDefault ([], 0) pk . generalRelays) + updateRelays (AccountId $ pubKeyXOToBech32 pk) updatedRelays AddDMRelay pk r -> do timestamp <- getCurrentTime diff --git a/src/Nostr/Subscription.hs b/src/Nostr/Subscription.hs index 8bb0278..aa1cb6c 100644 --- a/src/Nostr/Subscription.hs +++ b/src/Nostr/Subscription.hs @@ -30,6 +30,7 @@ import Nostr.Types (Event(..), EventId(..), Kind(..), Relay(..), RelayURI, Reque import Nostr.Util import Types ( AppState(..), Follow(..), FollowModel(..), UIReferences(..) , OutboxModelState(..), PublishStatus(..), RelayData(..), RelayPoolState(..)) +import Presentation.KeyMgmt (AccountId(..), KeyMgmt, updateProfile) -- Subscription Effects @@ -47,6 +48,7 @@ type SubscriptionEff es = ( GiftWrap :> es , State RelayPoolState :> es , State OutboxModelState :> es , State AppState :> es + , KeyMgmt :> es , Logging :> es , Nostr :> es , Util :> es @@ -248,11 +250,19 @@ handleEvent event' _ = do Metadata -> do case eitherDecode (BSL.fromStrict $ TE.encodeUtf8 $ content event') of Right profile -> do - modify $ \st -> st { profiles = Map.insertWith (\new old -> if snd new > snd old then new else old) + st <- get @AppState + let isOwnProfile = maybe False (\kp -> pubKey event' == keyPairToPubKeyXO kp) (keyPair st) + + modify $ \s -> s { profiles = Map.insertWith (\new old -> if snd new > snd old then new else old) (pubKey event') (profile, createdAt event') - (profiles st) + (profiles s) } + + when isOwnProfile $ do + let aid = AccountId $ pubKeyXOToBech32 (pubKey event') + updateProfile aid profile + pure $ emptyUpdates { profilesChanged = True } Left err -> do logWarning $ "Failed to decode metadata: " <> pack err diff --git a/src/Presentation/KeyMgmt.hs b/src/Presentation/KeyMgmt.hs index c1b5e05..e7c0731 100644 --- a/src/Presentation/KeyMgmt.hs +++ b/src/Presentation/KeyMgmt.hs @@ -7,7 +7,7 @@ module Presentation.KeyMgmt where import Control.Monad (filterM) -import Data.Aeson (FromJSON (..), eitherDecode) +import Data.Aeson (FromJSON (..), eitherDecode, encode) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (catMaybes, fromMaybe) @@ -28,26 +28,30 @@ import Effectful.FileSystem ) import Effectful.FileSystem.IO.ByteString qualified as FIOE (readFile, writeFile) import Effectful.FileSystem.IO.ByteString.Lazy qualified as BL -import Effectful.State.Static.Shared (State, get, modify) +import Effectful.State.Static.Shared (State, get, gets, modify) import Effectful.TH import EffectfulQML import Graphics.QML hiding (fireSignal, runEngineLoop) + +import Logging import Nostr import Nostr.Bech32 import Nostr.Keys ( KeyPair, PubKeyXO, SecKey, derivePublicKeyXO , keyPairToPubKeyXO, keyPairToSecKey, secKeyToKeyPair) import Nostr.Types hiding (displayName, picture) +import Nostr.Types (Profile(..)) import System.FilePath (takeFileName, ()) import Text.Read (readMaybe) +import qualified Nostr.Types as NT -- | Account. data Account = Account - { nsec :: SecKey, - npub :: PubKeyXO, - displayName :: Maybe Text, - picture :: Maybe Text, - relays :: ([Relay], Int) + { accountNsec :: SecKey, + accountNpub :: PubKeyXO, + accountDisplayName :: Maybe Text, + accountPicture :: Maybe Text, + accountRelays :: ([Relay], Int) } deriving (Eq, Show) @@ -85,7 +89,8 @@ type KeyMgmtEff es = ( State KeyMgmtState :> es , Nostr :> es , FileSystem :> es , IOE :> es - , EffectfulQML :> es ) + , EffectfulQML :> es + , Logging :> es ) -- | Key Management Effects. data KeyMgmt :: Effect where @@ -93,6 +98,8 @@ data KeyMgmt :: Effect where ImportSeedphrase :: ObjRef () -> Text -> Text -> KeyMgmt m Bool GenerateSeedphrase :: ObjRef () -> KeyMgmt m () RemoveAccount :: ObjRef () -> Text -> KeyMgmt m () + UpdateRelays :: AccountId -> ([Relay], Int) -> KeyMgmt m () + UpdateProfile :: AccountId -> Profile -> KeyMgmt m () type instance DispatchOf KeyMgmt = Dynamic @@ -185,6 +192,35 @@ runKeyMgmt = interpret $ \_ -> \case then removeDirectoryRecursive dir else return () + UpdateRelays aid newRelays -> do + modify $ \st -> st + { accountMap = Map.adjust (\acc -> acc { accountRelays = newRelays }) aid (accountMap st) } + accounts <- gets accountMap + case Map.lookup aid accounts of + Just account -> do + let npubStr = unpack $ pubKeyXOToBech32 $ accountNpub account + dir <- getXdgDirectory XdgData $ "futrnostr/" ++ npubStr + BL.writeFile (dir "relays.json") (encode newRelays) + Nothing -> do + logError $ "Account not found: " <>accountId aid + return () + + UpdateProfile aid profile -> do + modify $ \st -> st + { accountMap = Map.adjust (\acc -> acc + { accountDisplayName = NT.displayName profile + , accountPicture = NT.picture profile + }) aid (accountMap st) + } + accounts <- gets accountMap + case Map.lookup aid accounts of + Just account -> do + let npubStr = unpack $ pubKeyXOToBech32 $ accountNpub account + dir <- getXdgDirectory XdgData $ "futrnostr/" ++ npubStr + BL.writeFile (dir "profile.json") (encode profile) + Nothing -> do + logError $ "Account not found: " <> accountId aid + return () -- | Run the Key Management UI effect. runKeyMgmtUI :: KeyMgmgtUIEff es => Eff (KeyMgmtUI : es) a -> Eff es a @@ -209,10 +245,10 @@ runKeyMgmtUI action = interpret handleKeyMgmtUI action accountClass <- newClass - [ prop "nsec" (secKeyToBech32 . nsec), - prop "npub" (pubKeyXOToBech32 . npub), - mprop "displayName" displayName, - mprop "picture" picture + [ prop "nsec" (secKeyToBech32 . accountNsec), + prop "npub" (pubKeyXOToBech32 . accountNpub), + mprop "displayName" accountDisplayName, + mprop "picture" accountPicture ] accountPool' <- newFactoryPool (newObject accountClass) @@ -311,11 +347,11 @@ loadAccount storageDir npubDir = do Just Account - { nsec = nsecKey, - npub = pubKeyXO, - relays = fromMaybe defaultRelays relayData, - displayName = profile >>= \(Profile _ d _ _ _ _) -> d, - picture = profile >>= \(Profile _ _ _ p _ _) -> p + { accountNsec = nsecKey, + accountNpub = pubKeyXO, + accountRelays = fromMaybe defaultRelays relayData, + accountDisplayName = profile >>= \(Profile _ d _ _ _ _) -> d, + accountPicture = profile >>= \(Profile _ _ _ p _ _) -> p } -- | Read a file and return its contents as a Maybe Text. @@ -343,9 +379,9 @@ accountFromKeyPair kp = (AccountId newNpub, account) newNpub = pubKeyXOToBech32 $ keyPairToPubKeyXO kp account = Account - { nsec = keyPairToSecKey kp, - npub = keyPairToPubKeyXO kp, - relays = defaultRelays, - displayName = Nothing, - picture = Nothing + { accountNsec = keyPairToSecKey kp, + accountNpub = keyPairToPubKeyXO kp, + accountRelays = defaultRelays, + accountDisplayName = Nothing, + accountPicture = Nothing }