From 638bdddeb10b18dd35af5a6de2950aaa3c8a5e44 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Tue, 10 Dec 2024 14:28:30 -0500 Subject: Initial mrgreen activities --- src/Main.purs | 287 ++++------------------------------------------------------ 1 file changed, 18 insertions(+), 269 deletions(-) (limited to 'src/Main.purs') diff --git a/src/Main.purs b/src/Main.purs index c4b4fa5..6fff10b 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -2,279 +2,28 @@ module Main where import Prelude -import Audio as Audio -import Auth (AuthInfo, authHeader, getToken, startTwitchAuth, clearSessionCookie, getQueryRedirect, getResponseRedirect) import Config as Config -import Data.String as String -import Data.Array (head) -import Data.Array as Array -import Data.Foldable (fold) -import Data.Maybe (Maybe(..)) -import Data.Traversable (for, for_) -import Data.Tuple (Tuple(..)) -import Data.HTTP.Method (Method(..)) import Effect (Effect) -import Effect.Aff (Aff, launchAff_) -import Effect.Class (class MonadEffect, liftEffect) -import Effect.Console (log) import Effect.Exception (throw) -import Fetch (fetch) -import Model (startModel) -import UI as UI -import Web.DOM as DOM -import Web.DOM.DOMTokenList as DOM.DTL -import Web.DOM.Document (doctype) -import Web.DOM.Document as DOM.Doc -import Web.DOM.Element as DOM.El -import Web.DOM.Node as DOM.Node -import Web.DOM.NodeList as DOM.NL -import Web.DOM.NonElementParentNode as DOM.NEP -import Web.DOM.ParentNode as DOM.P -import Web.DOM.Text as DOM.Text -import Web.Event.Event as Ev -import Web.Event.EventTarget as Ev.Tar -import Web.HTML as HTML -import Web.HTML.HTMLDocument as HTML.Doc -import Web.HTML.HTMLInputElement as HTML.Input -import Web.HTML.Window as HTML.Win -import Web.XHR.FormData as FD - -maybeToArray :: forall a. Maybe a -> Array a -maybeToArray (Just x) = [x] -maybeToArray Nothing = [] - -byId :: forall m. MonadEffect m => String -> m DOM.Element -byId i = do - w <- liftEffect HTML.window - d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w - liftEffect (DOM.NEP.getElementById i (DOM.Doc.toNonElementParentNode d)) >>= case _ of - Nothing -> liftEffect $ throw $ "could not find element with id: " <> i - Just e -> pure e - -queryAll :: forall m. MonadEffect m => String -> m (Array DOM.Element) -queryAll q = do - w <- liftEffect HTML.window - d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w - nl <- liftEffect (DOM.P.querySelectorAll (DOM.P.QuerySelector q) (DOM.Doc.toParentNode d)) - ns <- liftEffect $ DOM.NL.toArray nl - pure $ fold $ (maybeToArray <<< DOM.El.fromNode) <$> ns - -query :: forall m . MonadEffect m => String -> m DOM.Element -query q = do - queryAll q >>= head >>> case _ of - Nothing -> liftEffect $ throw $ "could not find element matching query: " <> q - Just x -> pure x - -listen :: forall m. MonadEffect m => DOM.Element -> String -> (Ev.Event -> Effect Unit) -> m Unit -listen e ev f = do - l <- liftEffect $ Ev.Tar.eventListener f - liftEffect $ Ev.Tar.addEventListener (Ev.EventType ev) l false $ DOM.El.toEventTarget e - -create :: forall m. MonadEffect m => String -> Array String -> Array DOM.Element -> m DOM.Element -create tag classes children = do - w <- liftEffect HTML.window - d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w - el <- liftEffect $ DOM.Doc.createElement tag d - cl <- liftEffect $ DOM.El.classList el - for_ classes \c -> - liftEffect $ DOM.DTL.add cl c - for_ children \c -> - appendElement el c - pure el - -appendElement :: forall m. MonadEffect m => DOM.Element -> DOM.Element -> m Unit -appendElement parent child = liftEffect $ DOM.Node.appendChild (DOM.El.toNode child) (DOM.El.toNode parent) - -appendText :: forall m. MonadEffect m => DOM.Element -> String -> m Unit -appendText parent s = do - w <- liftEffect HTML.window - d <- liftEffect $ HTML.Doc.toDocument <$> HTML.Win.document w - n <- liftEffect $ DOM.Doc.createTextNode s d - liftEffect $ DOM.Node.appendChild (DOM.Text.toNode n) (DOM.El.toNode parent) - -setText :: forall m. MonadEffect m => DOM.Element -> String -> m Unit -setText e s = liftEffect $ DOM.Node.setTextContent s $ DOM.El.toNode e - -getValue :: forall m. MonadEffect m => DOM.Element -> m String -getValue e = case HTML.Input.fromElement e of - Just inp -> liftEffect $ HTML.Input.value inp - Nothing -> liftEffect $ throw "element is not an input" - -addClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit -addClass c e = do - cl <- liftEffect $ DOM.El.classList e - _ <- liftEffect $ DOM.DTL.add cl c - pure unit - -removeClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit -removeClass c e = do - cl <- liftEffect $ DOM.El.classList e - _ <- liftEffect $ DOM.DTL.remove cl c - pure unit - -toggleClass :: forall m. MonadEffect m => String -> DOM.Element -> m Unit -toggleClass c e = do - cl <- liftEffect $ DOM.El.classList e - _ <- liftEffect $ DOM.DTL.toggle cl c - pure unit - -updateSubtitle :: Aff Unit -updateSubtitle = do - subtitle <- byId "lcolonq-pubnix-index-subtitle" - { text: catchphrase } <- fetch (Config.apiServer <> "/catchphrase") {} - catchphrase >>= setText subtitle - -checkAuth :: AuthInfo -> Aff String -checkAuth auth = do - { text: resp } <- - fetch (Config.apiServer <> "/check") - { headers: - { "Authorization": authHeader auth - } - } - resp - -mainApi :: Effect Unit -mainApi = launchAff_ do - pure unit - -mainPubnix :: Effect Unit -mainPubnix = launchAff_ do - liftEffect $ log "hi" - startModel - marq <- byId "lcolonq-pubnix-index-marquee" - { text: motd } <- fetch (Config.apiServer <> "/motd") {} - motd >>= setText marq - - getToken >>= case _ of - Just a@(Tuple t n) -> do - liftEffect $ log t - liftEffect $ log n - checkAuth a >>= log >>> liftEffect - _ -> pure unit - - updateSubtitle - subtitle <- byId "lcolonq-pubnix-index-subtitle" - listen subtitle "click" \_ev -> do - -- startTwitchAuth - launchAff_ updateSubtitle - - for_ (Array.range 0 6) \i -> do - letter <- byId $ "lcolonq-pubnix-index-letter-" <> show i - listen letter "click" \_ev -> do - Audio.playVoice true i - listen letter "mouseover" \_ev -> do - Audio.playVoice false i - -mainExtension :: Effect Unit -mainExtension = launchAff_ do - liftEffect $ log "hello from extension" - UI.setInterval 1000.0 do - e <- query ".chat-scrollable-area__message-container" - new <- create "div" [".chat-line__message"] [] - appendText new "test" - appendElement e new - -mainObs :: Effect Unit -mainObs = launchAff_ do - startModel - -buttonPress :: String -> Aff Unit -buttonPress b = do - void $ fetch (Config.apiServer <> "/sentiment/" <> b) - { method: POST - } -mainButton :: Effect Unit -mainButton = launchAff_ do - liftEffect $ log "hello from button" - green <- byId "lcolonq-button-link-green" - listen green "click" \_ev -> do - liftEffect $ log "+2" - launchAff_ $ buttonPress "green" - red <- byId "lcolonq-button-link-red" - listen red "click" \_ev -> do - liftEffect $ log "-2" - launchAff_ $ buttonPress "red" - -mainRegister :: Effect Unit -mainRegister = launchAff_ do - liftEffect $ log "hello from registration page" - link <- byId "lcolonq-register-link" - getToken >>= case _ of - Just a@(Tuple t n) -> do -- if there's an auth token in the fragment, ask the API to register us - { text: resp } <- fetch (Config.apiServer <> "/register") - { headers: - { "Authorization": authHeader a - } - } - r <- resp - case String.split (String.Pattern " ") r of - [user, pass] -> do - container <- byId "lcolonq-registered-container" - removeClass "lcolonq-invisible" container - fieldUsername <- byId "lcolonq-registered-username" - setText fieldUsername user - fieldPassword <- byId "lcolonq-registered-password" - setText fieldPassword pass - _ -> do - container <- byId "lcolonq-register-error-container" - removeClass "lcolonq-invisible" container - _ -> do -- otherwise, show the button to register - container <- byId "lcolonq-register-container" - removeClass "lcolonq-invisible" container - listen link "click" \_ev -> do - liftEffect $ log "register" - startTwitchAuth - -mainMenu :: Effect Unit -mainMenu = launchAff_ do - liftEffect $ log "hello from menu" - textareas <- queryAll "textarea" - for_ textareas \ta -> listen ta "click" Ev.stopPropagation - boxes <- queryAll ".lcolonq-menu-box" - for_ boxes \box -> do - listen box "click" \_ev -> do - UI.submitRedeem box - -mainAuth :: Effect Unit -mainAuth = launchAff_ do - liftEffect $ log "hello from auth" - container <- byId "lcolonq-auth-login" - removeClass "lcolonq-invisible" container - form <- byId "lcolonq-auth-form" - listen form "submit" \ev -> launchAff_ do - liftEffect $ Ev.preventDefault ev - usernameInp <- byId "lcolonq-auth-username" - passwordInp <- byId "lcolonq-auth-password" - username <- getValue usernameInp - password <- getValue passwordInp - rd <- getQueryRedirect - { json: resp } <- fetch "/api/firstfactor" - { method: POST - , headers: { "Content-Type": "application/json" } - , body: UI.toJSON - { username - , password - , targetURL: case rd of - Just r -> r - Nothing -> "https://secure.colonq.computer" - } - } - res <- resp - getResponseRedirect res >>= case _ of - Nothing -> do - err <- byId "lcolonq-auth-error" - removeClass "lcolonq-invisible" err - Just r -> UI.redirect r +import Main.API as API +import Main.Auth as Auth +import Main.Button as Button +import Main.Extension as Extension +import Main.Greencircle as Greencircle +import Main.Menu as Menu +import Main.OBS as OBS +import Main.Pubnix as Pubnix +import Main.Register as Register main :: Effect Unit main = case Config.mode of - "api" -> mainApi - "pubnix" -> mainPubnix - "extension" -> mainExtension - "obs" -> mainObs - "button" -> mainButton - "register" -> mainRegister - "menu" -> mainMenu - "auth" -> mainAuth + "api" -> API.main + "pubnix" -> Pubnix.main + "extension" -> Extension.main + "obs" -> OBS.main + "button" -> Button.main + "register" -> Register.main + "menu" -> Menu.main + "auth" -> Auth.main + "greencircle" -> Greencircle.main _ -> throw $ "unknown mode: " <> Config.mode -- cgit v1.2.3