module Attach (
    AttachState(..),
    attachTemplate,
    initiateAttachConnection,
) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader

import Data.Proxy
import Data.Text qualified as T

import Erebos.Attach
import Erebos.Discovery
import Erebos.Error
import Erebos.Identity
import Erebos.Network
import Erebos.Object
import Erebos.Pairing
import Erebos.Service
import Erebos.State
import Erebos.Storable
import Erebos.Storage
import Erebos.Storage.Key

import Text.Blaze.Html5 ((!))
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as A

import JavaScript
import WebSocket (startClient, receiveMessage)


data AttachState = AttachState
    { asStorage :: Storage
    , asHead :: Head LocalState
    , asServer :: Server
    }


attachTemplate :: H.Html
attachTemplate = do
    H.h2 $ "Attach to other device"

    H.div ! A.class_ "content" $ do
        H.div ! A.class_ "warning" $ do
            "Deletes all local data, including conversations and contacts,\
            \ and synchronizes with the remote device."

        H.div ! A.id "attach_details" $ do
            H.div ! A.class_ "attach_details_item" $ do
                "Name: "
                H.span ! A.id "attach_details_name" $ return ()
            H.div ! A.class_ "attach_details_item" $ do
                "Confirmation code: "
                H.span ! A.id "attach_details_code" $ return ()

        H.button ! A.id "attach_confirm" ! A.disabled "" $ do
            "Confirm and proceed (deleting data)"

        H.button ! A.id "attach_cancel" $ do
            "Cancel"

initiateAttachConnection :: Head LocalState -> RefDigest -> IO AttachState
initiateAttachConnection baseHead dgst = do
    let baseStorage = headStorage baseHead
    Just nameElem <- getElementById "attach_details_name"
    Just codeElem <- getElementById "attach_details_code"
    Just confirmButton <- getElementById "attach_confirm"
    Just cancelButton <- getElementById "attach_cancel"

    asStorage <- deriveEphemeralStorage baseStorage
    asHead <- (either (fail . showErebosError) return =<<) $ runExceptT $ flip runReaderT asStorage $ do
        let devName = T.pack "WebApp"
        identity <- createIdentity (Just devName) Nothing
        storeHead asStorage $ LocalState
            { lsPrev = Nothing
            , lsIdentity = idExtData identity
            , lsShared = []
            , lsOther = []
            }

    asServer <- startServer defaultServerOptions asHead consoleLog
        [ someServiceAttr (defaultPairingAttributes (Proxy @AttachService))
            { pairingHookResponse = \confirm ->
                afterCommit $ do
                    setTextContent confirm codeElem
                    removeAttribute "disabled" confirmButton
            , pairingHookAcceptedResponse = do
                afterCommit $ do
                    Just chead <- reloadHead asHead
                    moveKeys asStorage baseStorage
                    void $ updateHead_ baseHead $ \_ -> return (headStoredObject chead)
                    locationAssign "./"
            }
        , someService @DiscoveryService Proxy
        ]

    attachRequested <- newMVar Nothing
    addEventListener confirmButton "click" $ \_ -> do
        readMVar attachRequested >>= \case
            Just peer -> do
                runExceptT (attachAccept peer) >>= \case
                    Right _ -> do
                        consoleLog "Attach accepted"
                    Left err -> do
                        consoleLog $ "Failed to accept attach: " <> showErebosError err
            Nothing -> do
                consoleLog $ "Attach not requested yet"
    addEventListener cancelButton "click" $ \_ -> do
        readMVar attachRequested >>= \case
            Just peer -> do
                runExceptT (attachReject peer) >>= \case
                    Right _ -> do
                        consoleLog "Attach rejected"
                    Left err -> do
                        consoleLog $ "Failed to reject attach: " <> showErebosError err
            Nothing -> return ()
        locationAssign "./"

    startClient asServer "a.discovery.erebosprotocol.net" 443 "" $ \conn -> do
        void $ forkIO $ forever $ do
            msg <- receiveMessage conn
            receivedFromCustomAddress asServer conn msg
        void $ serverPeerCustom asServer conn

    runExceptT (discoverySearch asServer dgst) >>= \case
        Right _ -> return ()
        Left err -> consoleLog $ "Failed to search for " <> show dgst <> ": " <> showErebosError err

    void $ forkIO $ do
        let loop = do
                peer <- getNextPeerChange asServer
                getPeerIdentity peer >>= \case
                    PeerIdentityFull pid
                        | dgst `elem` identityDigests pid -> do
                            modifyMVar_ attachRequested $ \case
                                Nothing -> do
                                    runExceptT (attachToOwner peer) >>= \case
                                        Right _ -> do
                                            consoleLog "Attach request sent"
                                            return $ Just peer
                                        Left err -> do
                                            consoleLog $ "Failed send attach request to " <> show dgst <> ": " <> showErebosError err
                                            return $ Nothing
                                cur -> return cur
                            setTextContent (T.unpack $ displayIdentity pid) nameElem
                    _ -> loop
        loop

    return AttachState {..}


identityDigests :: Foldable f => Identity f -> [ RefDigest ]
identityDigests pid = map (refDigest . storedRef) $ idDataF =<< unfoldOwners pid