{-# Language QuasiQuotes #-}

module Fig.Frontend where

import Fig.Prelude

import System.Random (randomRIO)

import Control.Lens (use, (^?), Ixed (..))
import qualified Control.Concurrent.Chan as Chan
import qualified Control.Concurrent.MVar as MVar

import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text.L
import qualified Data.ByteString.Base64 as BS.Base64
import qualified Data.Set as Set

import qualified Network.Wai as Wai
import qualified Network.Wai.Middleware.Static as Wai.Static
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.WebSockets as WS

import qualified Web.Scotty as Sc

import Fig.Utils.SExpr
import Fig.Bus.Client
import Fig.Frontend.Utils
import Fig.Frontend.Auth
import Fig.Frontend.State
import qualified Fig.Frontend.DB as DB

data LiveEvent
  = LiveEventOnline Text
  | LiveEventOffline Text
  deriving (Show, Eq, Ord)

server :: Config -> (Text, Text) -> IO ()
server cfg busAddr = do
  log $ "Frontend server running on port " <> tshow cfg.port
  liveEvents <- Chan.newChan @LiveEvent
  currentlyLive <- MVar.newMVar Set.empty
  busClient busAddr
    (\cmds -> do
        log "Connected to bus!"
        cmds.subscribe [sexp|(monitor twitch stream online)|]
        cmds.subscribe [sexp|(monitor twitch stream offline)|]
        Warp.run cfg.port =<< app cfg cmds liveEvents currentlyLive
    )
    (\_cmds d -> do
        case d of
          SExprList [ev, SExprString user]
            | ev == [sexp|(monitor twitch stream online)|] -> do
              log $ "Stream online: " <> user
              MVar.modifyMVar_ currentlyLive (pure . Set.insert user)
              Chan.writeChan liveEvents $ LiveEventOnline user
            | ev == [sexp|(monitor twitch stream offline)|] -> do
              log $ "Stream offline: " <> user
              MVar.modifyMVar_ currentlyLive (pure . Set.delete user)
              Chan.writeChan liveEvents $ LiveEventOffline user
          _ -> log $ "Invalid event: " <> tshow d
    )
    (pure ())

sexprStr :: Text -> SExpr
sexprStr = SExprString . BS.Base64.encodeBase64 . encodeUtf8

app :: Config -> Commands IO -> Chan.Chan LiveEvent -> MVar.MVar (Set.Set Text) -> IO Wai.Application
app cfg cmds liveEvents currentlyLive = do
  log "Connecting to database..."
  db <- DB.connect cfg
  log "Connected! Server active."
  st <- stateRef
  Sc.scottyApp do
    Sc.middleware $ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath
    Sc.get "/api/check" $ authed cfg \auth -> do
      Sc.json @[Text] [auth.id, auth.name]
    Sc.put "/api/buffer" do
      buf <- withState st $ use buffer 
      Sc.text $ Text.L.fromStrict buf
    Sc.get "/api/motd" do
      DB.get db "motd" >>= \case
        Nothing -> Sc.text ""
        Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
    Sc.get "/api/catchphrase" do
      let catchphrases =
            [ "vtuber (male)"
            , "man of letters"
            , "cool guy, online"
            , "internet clown man"
            , "professional emacs fan"
            , "web freak"
            , "guy who really likes programming"
            , "i use nixos btw"
            , "(are these funny or cringe or both?)"
            , "haha yay"
            , "Joel"
            ] :: [Text]
      i <- randomRIO (0, length catchphrases - 1)
      case catchphrases ^? ix i of
        Nothing -> Sc.text "man of letters"
        Just val -> Sc.text $ Text.L.fromStrict val
    Sc.get "/api/user/:name" do
      name <- Text.toLower <$> Sc.pathParam "name"
      DB.get db ("user:" <> encodeUtf8 name) >>= \case
        Nothing -> do
          Sc.status status404
          Sc.text "user not found"
        Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
    Sc.post "/api/redeem" do
      me <- Text.toLower <$> Sc.formParam "ayem"
      name <- Sc.formParam "name"
      input <- Sc.formParamMaybe "input"
      liftIO $ cmds.publish [sexp|(frontend redeem incoming)|]
        $ mconcat
          [ [ sexprStr me
            , sexprStr name
            ]
          , maybe [] ((:[]) . sexprStr) input
          ]
      Sc.text "it worked"
    Sc.get "/api/songs" do
      DB.hvals db "songnames" >>= \case
        Nothing -> do
          Sc.status status404
          Sc.text "no sounds found :("
        Just songs -> Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ SExprString . decodeUtf8 <$> songs
    Sc.get "/api/song/:hash" do
      hash <- Sc.pathParam "hash"
      DB.hget db "songnotes" hash >>= \case
        Nothing -> do
          Sc.status status404
          Sc.text "song not found"
        Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
    Sc.get "/api/poke/:name" do
      target <- encodeUtf8 . Text.toLower <$> Sc.pathParam "name"
      inbox <- fromMaybe [] <$> DB.smembers db ("pokeinbox:" <> target)
      Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ sexprStr . decodeUtf8 <$> inbox
    Sc.post "/api/poke/:name" do
      me <- encodeUtf8 . Text.toLower <$> Sc.formParam "ayem"
      target <- encodeUtf8 . Text.toLower <$> Sc.pathParam "name"
      DB.sismember db ("pokeinbox:" <> me) target >>= \case
        True -> do
          log . tshow $ "handshake between " <> me <> " and " <> target <> " complete!"
          DB.srem db ("pokeinbox:" <> target) [me]
          DB.srem db ("pokeinbox:" <> me) [target]
          Sc.text "complete"
        False -> do
          log . tshow $ "partial handshake from " <> me <> " to " <> target
          DB.sadd db ("pokeinbox:" <> target) [me]
          Sc.text "partial"
    Sc.get "/api/circle" do
      live <- liftIO $ MVar.readMVar currentlyLive
      Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ sexprStr <$> Set.toList live
    websocket "/api/circle/events" \conn -> do
      c <- Chan.dupChan liveEvents
      forever do
        ev <- liftIO $ Chan.readChan c
        WS.sendTextData conn $ case ev of
          LiveEventOnline u -> "online " <> u
          LiveEventOffline u -> "offline " <> u
    Sc.notFound do
      Sc.text "not found"