Enhanced nostr key management and relay handling

- Added Nostr.Effects.Dispatcher (new module for dispatching responses to subscriptions).
- Updated relay connection logic.
- Refactored relay pool state and effect handling.
- Updated WebSocket effect to remove responseQueue.
- Fix bugs in Nostr.Keys import and exports.
- Fix json format of nostr events.
- Updated default-extensions to include ConstraintKinds, LambdaCase, RankNTypes, and TemplateHaskell.

futr.cabal

@@ -31,6 +31,7 @@ executable futr
     other-modules:
         EffectfulQML
         Futr
+        Nostr.Effects.Dispatcher
         Nostr.Effects.IDGen
         Nostr.Effects.Logging
         Nostr.Effects.RelayPool
@@ -52,18 +53,23 @@ executable futr
     ghc-options:
         -threaded -Wall -Wcompat -Wincomplete-uni-patterns
         -Wincomplete-record-updates
-    default-extensions: DataKinds,
+    default-extensions: ConstraintKinds,
+                        DataKinds,
                         FlexibleContexts,
                         GADTs,
                         ImportQualifiedPost,
                         KindSignatures,
+                        LambdaCase,
                         OverloadedStrings,
+                        RankNTypes,
                         ScopedTypeVariables,
+                        TemplateHaskell,
                         TypeApplications,
                         TypeFamilies,
                         TypeOperators
     build-depends:
         aeson >=2.2.3.0 && <2.3,
+        async >=2.2.5 && <2.3,
         base >=4.17.2.1 && <4.18,
         base16-bytestring >=1.0.2.0 && <1.1,
         base64-bytestring >=1.2.1.0 && <1.3,

src/Futr.hs

@@ -1,18 +1,16 @@
 {-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module Futr where
 
-import Control.Monad (forM_,void)
+import Control.Monad (forM_, void)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Text (Text, pack, unpack)
+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
 import Effectful
 import Effectful.Concurrent
-import Effectful.Concurrent.STM (TQueue, atomically, readTQueue, writeTQueue)
+import Effectful.Concurrent.Async (async)
+import Effectful.Concurrent.STM (TQueue, atomically, readTQueue)
 import Effectful.Dispatch.Dynamic (interpret)
 import Effectful.State.Static.Shared (State, get, modify)
 import Effectful.TH
@@ -22,10 +20,12 @@ import Text.Read (readMaybe)
 
 import Nostr.Effects.Logging
 import Nostr.Effects.RelayPool
-import Nostr.Keys (KeyPair, PubKeyXO, secKeyToKeyPair)
-import Nostr.Types (Event(..), EventId, RelayURI, Response(..))
+import Nostr.Keys (KeyPair, PubKeyXO, bech32ToPubKeyXO, keyPairToPubKeyXO, secKeyToKeyPair)
+import Nostr.Types (Event(..), EventId, Filter(..), RelayURI, Response(..))
 import Presentation.KeyMgmt qualified as PKeyMgmt
 
+import Data.Maybe (fromJust)
+
 data AppScreen
     = KeyMgmt
     | Relay
@@ -82,7 +82,8 @@ type FutrEff es = (State FutrState :> es
                   , State RelayPoolState :> es
                   , EffectfulQML :> es
                   , Logging :> es
-                  , IOE :> es)
+                  , IOE :> es
+                  , Concurrent :> es)
 
 runFutr :: FutrEff es => Eff (Futr : es) a -> Eff es a
 runFutr = interpret $ \_ -> \case
@@ -93,16 +94,23 @@ runFutr = interpret $ \_ -> \case
       kst <- get @PKeyMgmt.KeyMgmtState
       case Map.lookup (PKeyMgmt.AccountId input) (PKeyMgmt.accountMap kst) of
         Just a -> do
-          modify $ \st' -> st' { keyPair = Just $ secKeyToKeyPair $ PKeyMgmt.nsec a, currentScreen = Home }
+          let kp = secKeyToKeyPair $ PKeyMgmt.nsec a
+          let xo = keyPairToPubKeyXO kp
+          logDebug $ "xo: " <> pack (show xo)
+          let xo' = fromJust $ bech32ToPubKeyXO "npub180cvv07tjdrrgpa0j7j7tmnyl2yr6yr7l8j4s3evf6u64th6gkwsyjh6w6"
+          logDebug $ "xo: " <> pack (show xo')
+          modify $ \st' -> st' { keyPair = Just kp, currentScreen = Home }
           fireSignal obj
-          st <- get @RelayPoolState
-          let rs = relays st
-          forM_ rs $ \(r, _) -> do
-            addRelay r
-            connect r
-          subId' <- subscribe [] $ map fst rs
-          --void $ forkIO $ processSubscriptionQueue
-          logDebug "Login completed"
+          let rs = PKeyMgmt.relays a
+          forM_ rs $ \r -> addRelay r
+          void . async $ forM_ rs $ \r -> connect r
+          now <- liftIO $ fmap (floor . (realToFrac :: POSIXTime -> Double)) getPOSIXTime
+          let initialFilters = [ FollowListFilter [ xo' ] now ]
+             --MetadataFilter contacts now
+             -- , TextNoteFilter contacts now
+          threadDelay 1000000
+          subs <- startSubscription initialFilters rs
+          return ()
         Nothing ->
             return ()
 

src/Main.hs

@@ -9,6 +9,7 @@ import Graphics.QML qualified as QML
 import System.Environment (setEnv)
 
 import Futr qualified as Futr
+import Nostr.Effects.Dispatcher (runDispatcher)
 import Nostr.Effects.IDGen (runIDGen)
 import Nostr.Effects.Logging (runLoggingStdout)
 import Nostr.Effects.RelayPool (runRelayPool)
@@ -38,6 +39,7 @@ main = do
         . KeyMgmt.runKeyMgmt
         . KeyMgmt.runKeyMgmtUI
         . evalState Futr.initialState
+        . runDispatcher
         . runWebSocket
         . runRelayPool
         . Futr.runFutr

src/Nostr/Effects/Dispatcher.hs

@@ -0,0 +1,56 @@
+module Nostr.Effects.Dispatcher where
+
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as T
+import Effectful
+import Effectful.Concurrent (Concurrent)
+import Effectful.Concurrent.STM (TQueue, atomically, writeTQueue)
+import Effectful.Dispatch.Dynamic (EffectHandler, interpret)
+import Effectful.State.Static.Shared (State, evalState, get)
+import Effectful.TH
+
+import Nostr.Effects.Logging
+import Nostr.Types
+
+-- | Effect for dispatching responses to subscriptions.
+data Dispatcher :: Effect where
+    DispatchResponse :: Response -> Dispatcher m ()
+
+makeEffect ''Dispatcher
+
+-- | State for the dispatcher.
+data DispatcherState = DispatcherState
+  { subscriptions :: Map SubscriptionId (TQueue Response, Relay)
+  }
+
+-- | Effect for dispatching responses to subscripti ns.
+type DispatcherEff es = (Logging :> es, Concurrent :> es)
+
+-- | Initial state for the dispatcher.
+initialState :: DispatcherState
+initialState = DispatcherState { subscriptions = Map.empty }
+
+-- | Run the dispatcher effect.
+runDispatcher :: DispatcherEff es => Eff (Dispatcher : State DispatcherState : es) a -> Eff es a
+runDispatcher action = evalState initialState $ interpret handleDispatcher action
+  where
+    handleDispatcher :: DispatcherEff es => EffectHandler Dispatcher (State DispatcherState : es)
+    handleDispatcher _ = \case
+      DispatchResponse response -> do
+        case response of
+          EventReceived subId' _ -> forwardResponse subId' response
+          Ok eventId' accepted msg -> logInfo $ "Event " <> (T.pack $ show eventId') <> if accepted then " accepted" else " rejected" <> ": " <> msg
+          Eose subId' -> forwardResponse subId' response
+          Closed subId' _ -> forwardResponse subId' response
+          Notice msg -> logWarning $ "Received notice: " <> msg
+
+    forwardResponse :: DispatcherEff es => SubscriptionId -> Response -> Eff (State DispatcherState : es) ()
+    forwardResponse subId' response = do
+      st <- get
+      case Map.lookup subId' (subscriptions st) of
+        Just (queue, _) -> do
+          logDebug $ "Forwarding response to subscription: " <> subId'
+          logDebug $ "Response: " <> T.pack (show response)
+          atomically $ writeTQueue queue response
+        Nothing -> logWarning $ "Received response for unknown subscription: " <> subId'