Skip to content

Commit

Permalink
- Add etag mention markers
Browse files Browse the repository at this point in the history 
- Implement comment display and creation
- Add repost functionality
- Add quote repost functionality
  • Loading branch information
@prolic
prolic committed Nov 30, 2024
1 parent 3988439 commit e9a05b7
Show file tree
Hide file tree
Showing 12 changed files with 923 additions and 172 deletions.
27 changes: 17 additions & 10 deletions src/EffectfulQML.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ initialEffectfulQMLState = EffectfulQMLState Nothing Nothing initialUIRefs Nothi

-- | Initial UI references.
initialUIRefs :: UIReferences
initialUIRefs = UIReferences Nothing Nothing Nothing Nothing Nothing
initialUIRefs = UIReferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing


-- | Define the effects for QML operations.
Expand Down Expand Up @@ -67,14 +67,21 @@ runEffectfulQML = interpret $ \_ -> \case
let combinedUpdates = uiUpdates <> mconcat moreUpdates

refs <- gets uiRefs

when (profilesChanged combinedUpdates) $ forM_ (profileObjRef refs) (liftIO . QML.fireSignal changeKey)
when (followsChanged combinedUpdates) $ forM_ (followsObjRef refs) (liftIO . QML.fireSignal changeKey)
when (chatsChanged combinedUpdates) $ forM_ (chatObjRef refs) (liftIO . QML.fireSignal changeKey)
when (dmRelaysChanged combinedUpdates) $ forM_ (dmRelaysObjRef refs) (liftIO . QML.fireSignal changeKey)
when (generalRelaysChanged combinedUpdates) $ forM_ (generalRelaysObjRef refs) (liftIO . QML.fireSignal changeKey)

threadDelay 100000 -- max 10 UI updates per second
-- Define update checks and their corresponding refs
let updates = [ (profilesChanged, profileObjRef)
, (followsChanged, followsObjRef)
, (postsChanged, postsObjRef)
, (privateMessagesChanged, privateMessagesObjRef)
, (dmRelaysChanged, dmRelaysObjRef)
, (generalRelaysChanged, generalRelaysObjRef)
, (tempRelaysChanged, tempRelaysObjRef)
]

forM_ updates $ \(checkFn, getRef) ->
when (checkFn combinedUpdates) $
forM_ (getRef refs) (liftIO . QML.fireSignal changeKey)

threadDelay 200000 -- 0.2 second delay for UI updates

liftIO $ QML.runEngineLoop config

Expand All @@ -90,7 +97,7 @@ runEffectfulQML = interpret $ \_ -> \case
st <- get
case queue st of
Just q -> do
let updates = emptyUpdates { dmRelaysChanged = True, generalRelaysChanged = True }
let updates = emptyUpdates { dmRelaysChanged = True, generalRelaysChanged = True, tempRelaysChanged = True }
atomically $ writeTQueue q updates
Nothing -> logError "No queue available"

Expand Down
201 changes: 183 additions & 18 deletions src/Futr.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,10 +6,11 @@ module Futr where

import Control.Monad (forM, forM_, unless, void, when)
import Data.Aeson (ToJSON, pairs, toEncoding, (.=))
import Data.Maybe (catMaybes, listToMaybe)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Proxy (Proxy(..))
import Data.Text (Text, isPrefixOf)
import Data.Set qualified as Set
import Data.Text (Text, isPrefixOf, pack)
import Data.Typeable (Typeable)
import Effectful
import Effectful.Concurrent
Expand All @@ -27,18 +28,18 @@ import Logging
import KeyMgmt (Account(..), AccountId(..), KeyMgmt, KeyMgmtState(..))
import Nostr
import Nostr.Bech32
import Nostr.Event (createFollowList, createRumor)
import Nostr.Event (createComment, createFollowList, createQuoteRepost, createRepost, createRumor, createShortTextNote)
import Nostr.Keys (PubKeyXO, derivePublicKeyXO, keyPairToPubKeyXO, secKeyToKeyPair)
import Nostr.GiftWrap
import Nostr.Publisher
import Nostr.RelayPool
import Nostr.Subscription
import Nostr.Types ( Relay(..), RelayURI, Tag(..)
import Nostr.Types ( Event(..), EventId, Profile(..), Relay(..), RelayURI, Tag(..)
, getUri, metadataFilter )
import Nostr.Util
import Presentation.KeyMgmtUI (KeyMgmtUI)
import Presentation.RelayMgmtUI (RelayMgmtUI)
import Types
import Types hiding (Comment, QuoteRepost, Repost)

-- | Signal key class for LoginStatusChanged.
data LoginStatusChanged deriving Typeable
Expand Down Expand Up @@ -70,7 +71,11 @@ data Futr :: Effect where
UnfollowProfile :: Text -> Futr m ()
OpenChat :: PubKeyXO -> Futr m ()
SendMessage :: Text -> Futr m ()
SendShortTextNote :: Text -> Futr m ()
Logout :: ObjRef () -> Futr m ()
Repost :: EventId -> Futr m ()
QuoteRepost :: EventId -> Text -> Futr m ()
Comment :: EventId -> Text -> Futr m ()


-- | Dispatch type for Futr effect.
Expand Down Expand Up @@ -167,27 +172,27 @@ runFutr = interpret $ \_ -> \case
OpenChat pubKeyXO -> do
st <- get @AppState

case currentChatRecipient st of
case currentContact st of
(Just _, Just subId') -> stopSubscription subId'
_ -> return ()

modify $ \st' -> st' { currentChatRecipient = (Just [pubKeyXO], Nothing) }
notify $ emptyUpdates { chatsChanged = True }
modify $ \st' -> st' { currentContact = (Just pubKeyXO, Nothing) }
notify $ emptyUpdates { privateMessagesChanged = True }

SendMessage input -> do
st <- get @AppState
case (keyPair st, currentChatRecipient st) of
(Just kp, (Just recipients, _)) -> do
case (keyPair st, currentContact st) of
(Just kp, (Just recipient, _)) -> do
now <- getCurrentTime
let senderPubKeyXO = keyPairToPubKeyXO kp
allRecipients = senderPubKeyXO : recipients
rumor = createRumor senderPubKeyXO now (map (\xo -> PTag xo Nothing Nothing) recipients) input
allRecipients = senderPubKeyXO : recipient : []
rumor = createRumor senderPubKeyXO now (map (\xo -> PTag xo Nothing Nothing) [recipient]) input

giftWraps <- forM allRecipients $ \recipient -> do
seal <- createSeal rumor kp recipient
giftWraps <- forM allRecipients $ \recipient' -> do
seal <- createSeal rumor kp recipient'
case seal of
Just seal' -> do
giftWrapResult <- createGiftWrap seal' recipient
giftWrapResult <- createGiftWrap seal' recipient'
case giftWrapResult of
Just (gw, _) -> return (Just gw)
Nothing -> logError "Failed to create gift wrap" >> return Nothing
Expand All @@ -199,6 +204,15 @@ runFutr = interpret $ \_ -> \case
(Nothing, _) -> logError "No key pair found"
(_, (Nothing, _)) -> logError "No current chat recipient"

SendShortTextNote input -> do
kp <- getKeyPair
now <- getCurrentTime
let u = createShortTextNote input (keyPairToPubKeyXO kp) now
signed <- signEvent u kp
case signed of
Just s -> publishToOutbox s
Nothing -> logError "Failed to sign short text note"

Logout obj -> do
modify @AppState $ \st -> st
{ keyPair = Nothing
Expand All @@ -218,6 +232,99 @@ runFutr = interpret $ \_ -> \case
fireSignal obj
logInfo "User logged out successfully"

Repost eid -> do
st <- get @AppState
case keyPair st of
Nothing -> logError "No keypair found"
Just kp -> do
now <- getCurrentTime
mEvent <- fetchEvent eid
case mEvent of
Nothing -> logError $ "Failed to fetch event " <> pack (show eid)
Just (_, []) -> do
logError "Failed to fetch event: no relays"
Just (event, r:_) -> do
let e = createRepost event r (keyPairToPubKeyXO kp) now
signed <- signEvent e kp
case signed of
Just s -> do
publishToOutbox s
case Map.lookup eid (events st) of
Just (origEvent, relays) -> do
genRelays <- gets @RelayPoolState generalRelays
let outboxUris = Set.fromList $ map getUri $
filter isOutboxCapable $ concatMap fst $ Map.elems genRelays

let eventRelayUris = Set.fromList relays
rps <- gets @RelayPoolState generalRelays
let authorInboxUris = case Map.lookup (pubKey origEvent) rps of
Just (authorRelays, _) ->
Set.fromList $ map getUri $ filter isInboxCapable authorRelays
Nothing -> Set.empty

let targetUris = (eventRelayUris `Set.union` authorInboxUris)
`Set.difference` outboxUris

forM_ (Set.toList targetUris) $ \relay ->
publishToRelay s relay
Nothing -> return ()
Nothing -> logError "Failed to sign repost"

QuoteRepost eid quote -> do
st <- get @AppState
case keyPair st of
Nothing -> logError "No keypair found"
Just kp -> do
now <- getCurrentTime
mEvent <- fetchEvent eid
case mEvent of
Nothing -> logError $ "Failed to fetch event " <> pack (show eid)
Just (_, []) -> do
logError "Failed to fetch event: no relays"
Just (event, r:_) -> do
let q = createQuoteRepost event r quote (keyPairToPubKeyXO kp) now
signed <- signEvent q kp
case signed of
Just s -> publishToOutbox s
Nothing -> logError "Failed to sign quote repost"

Comment eid comment -> do
st <- get @AppState
case keyPair st of
Nothing -> logError "No keypair found"
Just kp -> do
now <- getCurrentTime
mEvent <- fetchEvent eid
case mEvent of
Nothing -> logError $ "Failed to fetch event " <> pack (show eid)
Just (event, _) -> do
let c = createComment event comment (Right eid) Nothing Nothing (keyPairToPubKeyXO kp) now
signed <- signEvent c kp
case signed of
Just s -> do
publishToOutbox s
-- Publish to relays where the original event was seen
case Map.lookup eid (events st) of
Just (origEvent, relays) -> do
-- Publish to all relays where we saw the original event
forM_ relays $ \relay -> publishToRelay s relay
-- Also publish to inbox relays of the original author
let authorPk = pubKey origEvent
rps <- gets @RelayPoolState generalRelays
case Map.lookup authorPk rps of
Just (authorRelays, _) ->
forM_ (filter isInboxCapable authorRelays) $ \relay ->
publishToRelay s (getUri relay)
Nothing -> return ()
Nothing -> return ()
Nothing -> logError "Failed to sign comment"


-- Helper function to fetch an event
fetchEvent :: EventId -> FutrEff es => Eff es (Maybe (Event, [RelayURI]))
fetchEvent eid = do
es <- gets @AppState events
return $ Map.lookup eid es

-- Helper function to parse nprofile or npub
parseNprofileOrNpub :: Text -> Maybe (PubKeyXO, Maybe RelayURI)
Expand Down Expand Up @@ -287,9 +394,9 @@ searchInRelays pubkey' _ = do
Just (rs, _) -> rs
Nothing -> []
conns <- gets @RelayPoolState activeConnections
forM_ relays $ \r -> do
when (isInboxCapable r) $ do
let relayUri' = getUri r
forM_ relays $ \relay -> do
when (isInboxCapable relay) $ do
let relayUri' = getUri relay
when (Map.member relayUri' conns) $ do
subId' <- newSubscriptionId
mq <- subscribe relayUri' subId' [metadataFilter [pubkey']]
Expand All @@ -314,3 +421,61 @@ isInboxCapable :: Relay -> Bool
isInboxCapable (InboxRelay _) = True
isInboxCapable (InboxOutboxRelay _) = True
isInboxCapable _ = False


-- | Get the content of a post.
getPostContent :: FutrEff es => Post -> Eff es (Maybe Text)
getPostContent post = do
st <- get @AppState
return $ Map.lookup (postId post) (events st) >>= Just . content . fst

-- | Get the creation timestamp of a post.
getPostCreatedAt :: FutrEff es => Post -> Eff es (Maybe Int)
getPostCreatedAt post = do
st <- get @AppState
return $ Map.lookup (postId post) (events st) >>= Just . createdAt . fst


-- | Get the content of a referenced post.
getReferencedContent :: FutrEff es => EventId -> Eff es (Maybe Text)
getReferencedContent eid = do
st <- get @AppState
return $ Map.lookup eid (events st) >>= Just . content . fst

-- | Get the author of a referenced post.
getReferencedAuthor :: FutrEff es => EventId -> Eff es (Maybe PubKeyXO)
getReferencedAuthor eid = do
st <- get @AppState
return $ Map.lookup eid (events st) >>= Just . pubKey . fst


-- | Get the author name of a referenced post.
getReferencedAuthorName :: FutrEff es => EventId -> Eff es (Maybe Text)
getReferencedAuthorName eid = do
st <- get @AppState
case Map.lookup eid (events st) of
Nothing -> return Nothing
Just (event, _) -> do
let authorPubKey = pubKey event
authorProfile = Map.lookup authorPubKey (profiles st)
return $ case authorProfile of
Just profileData -> Just $ fromMaybe
(fromMaybe (pubKeyXOToBech32 authorPubKey) (name $ fst profileData))
(displayName $ fst profileData)
Nothing -> Just $ pubKeyXOToBech32 authorPubKey

-- | Get the author picture of a referenced post.
getReferencedAuthorPicture :: FutrEff es => EventId -> Eff es (Maybe Text)
getReferencedAuthorPicture eid = do
st <- get @AppState
case Map.lookup eid (events st) of
Nothing -> return Nothing
Just (event, _) -> do
let authorPubKey = pubKey event
return $ Map.lookup authorPubKey (profiles st) >>= picture . fst

-- | Get the creation timestamp of a referenced post.
getReferencedCreatedAt :: FutrEff es => EventId -> Eff es (Maybe Int)
getReferencedCreatedAt eid = do
st <- get @AppState
return $ Map.lookup eid (events st) >>= Just . createdAt . fst
Loading

0 comments on commit e9a05b7

Please sign in to comment.