content: {-# LANGUAGE BlockArguments #-}
  {-# LANGUAGE DeriveAnyClass #-}
  
  module Futr where
  
  import Control.Monad (forM, forM_, unless, void, when)
  import Data.Aeson (ToJSON, pairs, toEncoding, (.=))
  import Data.List (nub)
  import Data.Map.Strict qualified as Map
  import Data.Maybe (catMaybes)
  import Data.Proxy (Proxy(..))
  import Data.Set qualified as Set
  import Data.Text (Text, isPrefixOf, unpack)
  import Data.Typeable (Typeable)
  import Effectful
  import Effectful.Concurrent
  import Effectful.Concurrent.Async (async, cancel, forConcurrently_)
  import Effectful.Dispatch.Dynamic (interpret, send)
  import Effectful.Exception (SomeException, try)
  import Effectful.FileSystem
    ( FileSystem,
      XdgDirectory (XdgData),
      createDirectoryIfMissing,
      getXdgDirectory
    )
  import Effectful.State.Static.Shared (State, get, gets, modify, put)
  import Lmdb.Connection (closeEnvironment)
  import QtQuick
  import GHC.Generics (Generic)
  import Graphics.QML hiding (fireSignal, runEngineLoop)
  import Graphics.QML qualified as QML
  import System.FilePath ((</>))
  
  import Downloader (Downloader)
  import Logging
  import KeyMgmt (Account(..), AccountId(..), KeyMgmt, KeyMgmtState(..))
  import Nostr
  import Nostr.Bech32
  import Nostr.Event ( Event(..), EventId, UnsignedEvent(..)
                     , createComment, createEventDeletion, createFollowList
                     , createRepost, createRumor, createShortTextNote, eventIdToHex
                     )
  import Nostr.Event qualified as NE
  import Nostr.EventProcessor (handleEvent)
  import Nostr.InboxModel ( InboxModel, startInboxModel, stopInboxModel
                          , subscribeToCommentsFor, subscribeToProfilesAndPostsFor, unsubscribeToCommentsFor )
  import Nostr.Keys (PubKeyXO, derivePublicKeyXO, keyPairToPubKeyXO, pubKeyXOToHex, secKeyToKeyPair)
  import Nostr.Nip05Search (isNip05Identifier, searchNip05, Nip05SearchResult(..))
  import Nostr.ProfileManager (ProfileManager, initializeProfileManager)
  import Nostr.Publisher
  import Nostr.Relay ( RelayConnection, RelayPool(..), connect, disconnect
                     , initialRelayPool, subscribeTemporary, unsubscribe )
  import Nostr.Types (RelayURI, getUri, isInboxCapable, isValidRelayURI, metadataFilter)
  import Nostr.Util
  import Presentation.Classes (Classes)
  import Presentation.KeyMgmtUI (KeyMgmtUI)
  import Presentation.RelayMgmtUI (RelayMgmtUI)
  import RelayMgmt (RelayMgmt)
  import Store.Lmdb ( LmdbState(..), LmdbStore, initialLmdbState, initializeLmdbState
                    , getEvent, getEventRelays, getGeneralRelays )
  import Types
  
  -- | Signal key class for LoginStatusChanged.
  data LoginStatusChanged deriving Typeable
  
  instance SignalKeyClass LoginStatusChanged where
      type SignalParams LoginStatusChanged = Bool -> Text -> IO ()
  
  
  -- | Signal key class for DownloadCompleted.
  data DownloadCompleted deriving Typeable
  
  instance SignalKeyClass DownloadCompleted where
      type SignalParams DownloadCompleted = Bool -> Text -> IO ()
  
  
  -- | Signal key class for MediaPeekCompleted.
  data MediaPeekCompleted deriving Typeable
  
  instance SignalKeyClass MediaPeekCompleted where
      type SignalParams MediaPeekCompleted = Text -> Text -> IO ()  -- url -> mimeType -> IO ()
  
  
  -- | Signal key class for MediaCacheCompleted.
  data MediaCacheCompleted deriving Typeable
  
  instance SignalKeyClass MediaCacheCompleted where
      type SignalParams MediaCacheCompleted = Text -> Bool -> Text -> IO ()  -- url -> success -> pathOrError -> IO ()
  
  
  -- | Search result.
  data SearchResult
    = ProfileResult { npub :: Text, relayUris :: [Text] }
    | Nip05Result { npub :: Text, nip05 :: Text, relayUris :: [Text] }
    | NoResult
    deriving (Eq, Generic, Show)
  
  instance ToJSON SearchResult where
    toEncoding (ProfileResult npub' relayUris') = pairs
       ( "npub"  .= npub'
      <> "relayUris" .= relayUris'
       )
    toEncoding (Nip05Result npub' nip05' relayUris') = pairs
       ( "npub" .= npub'
      <> "nip05" .= nip05'
      <> "relayUris" .= relayUris'
       )
    toEncoding NoResult = pairs ( "result" .= ("no_result" :: Text) )
  
  
  -- | Futr Effects.
  data Futr :: Effect where
    Login :: ObjRef () -> Text -> Futr m ()
    Search :: ObjRef () -> Text -> Futr m SearchResult
    SetCurrentPost :: Maybe EventId -> Futr m ()
    FollowProfile :: Text -> Futr m ()
    UnfollowProfile :: Text -> Futr m ()
    LoadFeed :: FeedFilter -> Futr m ()
    SendPrivateMessage :: 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 ()
    DeleteEvent :: EventId -> Text -> Futr m ()
    CancelLogin :: ObjRef () -> Futr m ()
  
  
  -- | Dispatch type for Futr effect.
  type instance DispatchOf Futr = Dynamic
  
  
  login :: Futr :> es => ObjRef () -> Text -> Eff es ()
  login obj input = send $ Login obj input
  
  search :: Futr :> es => ObjRef () -> Text -> Eff es SearchResult
  search obj input = send $ Search obj input
  
  setCurrentPost :: Futr :> es => Maybe EventId -> Eff es ()
  setCurrentPost eid = send $ SetCurrentPost eid
  
  followProfile :: Futr :> es => Text -> Eff es ()
  followProfile npub' = send $ FollowProfile npub'
  
  unfollowProfile :: Futr :> es => Text -> Eff es ()
  unfollowProfile npub' = send $ UnfollowProfile npub'
  
  loadFeed :: Futr :> es => FeedFilter -> Eff es ()
  loadFeed f = send $ LoadFeed f
  
  sendPrivateMessage :: Futr :> es => Text -> Eff es ()
  sendPrivateMessage input = send $ SendPrivateMessage input
  
  sendShortTextNote :: Futr :> es => Text -> Eff es ()
  sendShortTextNote input = send $ SendShortTextNote input
  
  logout :: Futr :> es => ObjRef () -> Eff es ()
  logout obj = send $ Logout obj
  
  repost :: Futr :> es => EventId -> Eff es ()
  repost eid = send $ Repost eid
  
  quoteRepost :: Futr :> es => EventId -> Text -> Eff es ()
  quoteRepost eid quote = send $ QuoteRepost eid quote
  
  comment :: Futr :> es => EventId -> Text -> Eff es ()
  comment eid comment' = send $ Comment eid comment'
  
  deleteEvent :: Futr :> es => EventId -> Text -> Eff es ()
  deleteEvent eid reason = send $ DeleteEvent eid reason
  
  cancelLogin :: Futr :> es => ObjRef () -> Eff es ()
  cancelLogin obj = send $ CancelLogin obj
  
  
  -- | Effectful type for Futr.
  type FutrEff es =
    ( State AppState :> es
    , State LmdbState :> es
    , LmdbStore :> es
    , KeyMgmt :> es
    , KeyMgmtUI :> es
    , RelayMgmtUI :> es
    , Downloader :> es
    , Nostr :> es
    , ProfileManager :> es
    , InboxModel :> es
    , RelayConnection :> es
    , RelayMgmt :> es
    , Publisher :> es
    , State KeyMgmtState :> es
    , State RelayPool :> es
    , State QtQuickState :> es
    , QtQuick :> es
    , Classes :> es
    , Logging :> es
    , IOE :> es
    , FileSystem :> es
    , Concurrent :> es
    , Util :> es
    )
  
  
  -- | Run the Futr effect.
  runFutr :: FutrEff es => Eff (Futr : es) a -> Eff es a
  runFutr = interpret $ \_ -> \case
    Login obj input -> do
        kst <- get @KeyMgmtState
        case Map.lookup (AccountId input) (accountMap kst) of
          Nothing -> pure ()
          Just a -> do
            let pk = accountPubKeyXO a
  
            dbResult <- try @SomeException $ do
                baseDir <- getXdgDirectory XdgData ("futrnostr" </> unpack (pubKeyXOToBech32 pk))
                let lmdbDir = baseDir </> "db"
                createDirectoryIfMissing True lmdbDir
                lmdbState <- liftIO $ initializeLmdbState lmdbDir
                put @LmdbState lmdbState
  
            case dbResult of
              Left e -> error $ "Database initialization failed: " <> show e
              Right _ -> do
                initializeProfileManager
                loginWithAccount obj a
  
                -- Stop any previous cache clearer
                mOld <- gets @AppState cacheClearer
                forM_ mOld $ \old -> cancel old
  
                -- -- Start new cache clearer
                -- t <- async $ forever $ do
                --   clearCache
                --   threadDelay (5 * 60 * 1000000) -- 5 minutes in microseconds
  
                -- modify @AppState $ \s -> s { cacheClearer = Just t }
  
    Search _ input -> do
      st <- get @AppState
      let myPubKey = keyPairToPubKeyXO <$> keyPair st
  
      -- Check if input is a NIP-05 identifier (email-like)
      if isNip05Identifier input
        then do
          -- Perform NIP-05 search
          nip05Result <- liftIO $ searchNip05 input
          case nip05Result of
            Just (Nip05SearchResult nip05Id userPubKey relayHints) -> do
              let npubStr = pubKeyXOToBech32 userPubKey
              -- Check if it's the current user
              if Just userPubKey == myPubKey
                then return $ Nip05Result npubStr nip05Id relayHints
                else do
                  -- Check if already following
                  currentFollows <- gets @AppState currentFollows
                  if Map.member userPubKey currentFollows
                    then return $ Nip05Result npubStr nip05Id relayHints
                    else do
                      -- Search in relays to get more info about the user
                      searchInRelays userPubKey relayHints
                      return $ Nip05Result npubStr nip05Id relayHints
            Nothing -> return NoResult
        -- Check for nprofile/npub format
        else if "nprofile" `isPrefixOf` input || "npub" `isPrefixOf` input
          then case parseNprofileOrNpub input of
            Nothing -> return NoResult
            Just (pubkey', relayUris)
              | Just pubkey' == myPubKey -> return $ ProfileResult (pubKeyXOToBech32 pubkey') relayUris
              | otherwise -> do
                  currentFollows <- gets @AppState currentFollows
                  if Map.member pubkey' currentFollows
                    then return $ ProfileResult (pubKeyXOToBech32 pubkey') relayUris
                    else do
                      searchInRelays pubkey' relayUris
                      return $ ProfileResult (pubKeyXOToBech32 pubkey') relayUris
          else return NoResult
  
    SetCurrentPost eid -> do
      previousPost <- gets @AppState currentPost
      let commentFeedFilter = case eid of
            Just eid' -> Just $ CommentsFilter eid'
            Nothing -> Nothing
      modify @AppState $ \st -> st { currentPost = eid, currentCommentFeed = commentFeedFilter }
  
      case (eid, previousPost) of
        (Just newId, Just oldId) -> when (newId == oldId) $ do
            unsubscribeToCommentsFor oldId
            subscribeToCommentsFor newId
        (Just newId, Nothing) -> subscribeToCommentsFor newId
        (Nothing, Just oldId) -> unsubscribeToCommentsFor oldId
        (Nothing, Nothing) -> pure ()
  
    FollowProfile npub' -> do
      let targetPK = maybe (error "Invalid bech32 public key") id $ bech32ToPubKeyXO npub'
      st <- get @AppState
      case keyPairToPubKeyXO <$> keyPair st of
          Just _ -> do
              let followsList = Map.elems $ currentFollows st
              unless (targetPK `elem` map pubkey followsList) $ do
                  let newFollow = Follow targetPK Nothing
                      newFollows = newFollow : followsList
                  sendFollowListEvent newFollows
                  notify $ emptyUpdates { myFollowsChanged = True }
          Nothing -> return ()
  
    UnfollowProfile npub' -> do
      let targetPK = maybe (error "Invalid bech32 public key") id $ bech32ToPubKeyXO npub'
      st <- get @AppState
      case keyPairToPubKeyXO <$> keyPair st of
          Just _ -> do
              let followsList = Map.elems $ currentFollows st
                  newFollows = filter ((/= targetPK) . pubkey) followsList
              sendFollowListEvent newFollows
              notify $ emptyUpdates { myFollowsChanged = True }
          Nothing -> return ()
  
    LoadFeed f -> do
      --logDebug $ "LoadFeed: " <> pack (show f)
      let pk = case f of
            PostsFilter pk' -> pk'
            PrivateMessagesFilter pk' -> pk'
            CommentsFilter _ -> error "LoadFeed not supported for CommentsFilter - use getCommentFeed instead"
  
      st <- get @AppState
  
      case currentProfile st of
        Just (_, subIds) -> forM_ subIds $ \subId' -> unsubscribe subId'
        _ -> pure ()
  
      modify @AppState $ \st' -> st'
        { currentProfile = Just (pk, [])
        , currentFeed = Just f
        }
      notify $ emptyUpdates { feedChanged = True }
  
      void $ async $ do
        subIds <- subscribeToProfilesAndPostsFor pk
        modify @AppState $ \st' -> st' { currentProfile = Just (pk, subIds) }
  
    SendPrivateMessage input -> do
      st <- get @AppState
      case (keyPair st, currentProfile st) of
        (Just kp, Just (recipient, _)) -> do
          now <- getCurrentTime
          let senderPubKeyXO = keyPairToPubKeyXO kp
              allRecipients = nub [senderPubKeyXO, recipient]
              rumor = createRumor senderPubKeyXO now (map (\xo -> ["p", pubKeyXOToHex xo]) [recipient]) input
  
          giftWraps <- forM allRecipients $ \recipient' -> do
            seal <- createSeal rumor kp recipient'
            case seal of
              Just seal' -> do
                giftWrapResult <- createGiftWrap seal' recipient'
                case giftWrapResult of
                  Just (gw, _) -> return (Just gw)
                  Nothing -> return Nothing
              Nothing -> return Nothing
  
          let validGiftWraps = catMaybes giftWraps
  
          forM_ validGiftWraps $ \gw -> do
            publishGiftWrap gw senderPubKeyXO recipient
          notify $ emptyUpdates { feedChanged = True }
  
        (Nothing, _) -> error "No key pair found"
        (_, Nothing) -> error "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 -> do
          publishToOutbox s
          notify $ emptyUpdates { feedChanged = True }
        Nothing -> error "Failed to sign short text note"
  
    Logout obj -> do
      fullAppCleanup
      --logInfo "User logged out successfully"
      fireSignal obj
  
      -- Stop cache clearer thread if running
      mClearer <- gets @AppState cacheClearer
      forM_ mClearer $ \a -> cancel a
      modify @AppState $ \s -> s { cacheClearer = Nothing }
  
    Repost eid -> do
      kp <- getKeyPair
      now <- getCurrentTime
      mEvent <- getEvent eid
      case mEvent of
        Nothing -> pure ()
        Just event -> do
          relays <- getEventRelays eid
          let e = createRepost event (Set.findMin relays) (keyPairToPubKeyXO kp) now
          signed <- signEvent e kp
          case signed of
            Nothing -> error "Failed to sign repost"
            Just s -> do
              publishToOutbox s
              mEventAndRelays <- getEvent eid
              case mEventAndRelays of
                Nothing -> return ()
                Just origEvent -> do
                  relaySet <- getEventRelays eid
                  let eventRelayUris = Set.fromList $
                        [ uri | ("r":uri:_) <- tags origEvent
                        , isValidRelayURI uri
                        ]
  
                  authorRelays <- getGeneralRelays (pubKey origEvent)
                  let authorInboxUris = Set.fromList $ map getUri $
                        filter isInboxCapable authorRelays
  
                  let targetUris = eventRelayUris `Set.union` authorInboxUris `Set.union` relaySet
  
                  forM_ (Set.toList targetUris) $ \relay ->
                    publishToRelay s relay
                  notify $ emptyUpdates { feedChanged = True }
  
    QuoteRepost eid quote -> do
      kp <- getKeyPair
      now <- getCurrentTime
      mEvent <- getEvent eid
      case mEvent of
        Nothing -> pure ()
        Just event -> do
          relays <- getEventRelays $ eventId event
          let q = createQuoteRepost event (Set.findMin relays) quote (keyPairToPubKeyXO kp) now
          signed <- signEvent q kp
          case signed of
            Nothing -> error "Failed to sign quote repost"
            Just s -> do
              publishToOutbox s
              notify $ emptyUpdates { feedChanged = True }
      where
        createQuoteRepost :: Event -> RelayURI -> Text -> PubKeyXO -> Int -> UnsignedEvent
        createQuoteRepost event relayUrl quote' xo t =
          UnsignedEvent
            { pubKey' = xo
            , createdAt' = t
            , kind' = NE.ShortTextNote
            , tags' = [ ["q", eventIdToHex $ eventId event, relayUrl, pubKeyXOToHex $ pubKey event]
                      ]
            , content' = quote' <> "\n\nnostr:" <> eventToNevent event [relayUrl]
            }
  
    Comment eid comment' -> do
      kp <- getKeyPair
      now <- getCurrentTime
      mEvent <- getEvent eid
      case mEvent of
        Nothing -> pure ()
        Just ev -> do
          let c = createComment ev comment' (keyPairToPubKeyXO kp) now
          signed <- signEvent c kp
          case signed of
            Nothing -> error "Failed to sign comment"
            Just s -> do
              publishToOutbox s
              mEventAndRelays <- getEvent eid
              case mEventAndRelays of
                Just origEvent -> do
                  relaySet <- getEventRelays eid
                  let eventRelayUris = Set.fromList $
                        [ uri | ("r":uri:_) <- tags origEvent
                        , isValidRelayURI uri
                        ]
  
                  authorRelays <- getGeneralRelays (pubKey origEvent)
                  let authorInboxUris = Set.fromList $ map getUri $
                        filter isInboxCapable authorRelays
  
                  let targetUris = eventRelayUris `Set.union` authorInboxUris `Set.union` relaySet
  
                  forM_ (Set.toList targetUris) $ \relay ->
                    publishToRelay s relay
                  notify $ emptyUpdates { feedChanged = True }
                Nothing -> return ()
  
    Futr.DeleteEvent eid reason -> do
        kp <- getKeyPair
        now <- getCurrentTime
        mEvent <- getEvent eid
        case mEvent of
            Nothing -> pure ()
            Just ev -> do
                let deletion = createEventDeletion ev reason (keyPairToPubKeyXO kp) now
                signed <- signEvent deletion kp
                case signed of
                    Nothing -> error "Failed to sign event deletion"
                    Just s -> do
                        publishToOutbox s
                        notify $ emptyUpdates { feedChanged = True }
  
    CancelLogin obj -> do
      fullAppCleanup
      liftIO $ QML.fireSignal (Proxy :: Proxy LoginStatusChanged) obj False "Login cancelled"
      --logInfo "Login cancelled"
      fireSignal obj
  
      -- Stop cache clearer thread if running
      mClearer <- gets @AppState cacheClearer
      forM_ mClearer $ \a -> cancel a
      modify @AppState $ \s -> s { cacheClearer = Nothing }
  
  
  -- Helper function to parse nprofile or npub
  parseNprofileOrNpub :: Text -> Maybe (PubKeyXO, [RelayURI])
  parseNprofileOrNpub input =
    case bech32ToPubKeyXO input of
      Just pubkey' -> Just (pubkey', [])  -- for npub
      Nothing -> nprofileToPubKeyXO input  -- for nprofile
  
  
  -- | Login with an account.
  loginWithAccount :: FutrEff es => ObjRef () -> Account -> Eff es ()
  loginWithAccount obj a = do
      modify @AppState $ \s -> s { keyPair = Just (secKeyToKeyPair $ accountSecKey a) }
      modify @KeyMgmtState $ \st -> st
          { nsecView = secKeyToBech32 $ accountSecKey a
          , npubView = pubKeyXOToBech32 $ derivePublicKeyXO $ accountSecKey a
          }
  
      modify @AppState $ \s -> s { currentScreen = Home }
      liftIO $ QML.fireSignal (Proxy :: Proxy LoginStatusChanged) obj True ""
      fireSignal obj
      void $ async $ startInboxModel
  
  
  -- | Send a follow list event.
  sendFollowListEvent :: FutrEff es => [Follow] -> Eff es ()
  sendFollowListEvent follows = do
      kp <- getKeyPair
      let userPK = keyPairToPubKeyXO kp
      currentTime <- getCurrentTime
      let followTuples = map (\f -> (pubkey f, Nothing)) follows
      let event = createFollowList followTuples userPK currentTime
      signedEvent <- signEvent event kp
      case signedEvent of
          Just signedEvent' -> do
              publishToOutbox signedEvent'
          Nothing -> error "Failed to sign follow list event"
  
  
  -- | Search for a profile in relays.
  searchInRelays :: FutrEff es => PubKeyXO -> [RelayURI] -> Eff es ()
  searchInRelays xo relayUris = do
    st <- get @AppState
    let relays = Map.elems $ currentGeneralRelays st
  
    let searchRelays = case relayUris of
            [relayUri] -> [relayUri]
            _ -> map getUri relays
  
    forConcurrently_ searchRelays $ \relayUri -> do
      connected <- connect relayUri
      when connected $ void $ subscribeTemporary relayUri (metadataFilter [xo]) handleEvent
  
  
  -- | Helper to fully clean up app state, disconnect all relays, and fire signal
  fullAppCleanup :: FutrEff es => Eff es ()
  fullAppCleanup = do
    stopInboxModel
  
    relayPool <- get @RelayPool
    let relayUris = Map.keys (activeConnections relayPool)
    forM_ relayUris disconnect
  
    threadDelay 100000
  
    st <- get @LmdbState
    liftIO $ closeEnvironment (lmdbEnv st)
  
    put @LmdbState initialLmdbState
    put @AppState initialState
    put @RelayPool initialRelayPool
  