{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Server
-- Description :
--  This module creates a postgresql connection through hasql, a datastructure for events
--  and spawn a dedicated thread listening to postgresql event, and publishing to graphql
--  server events.
module Server where

import Control.Concurrent (forkIO)
import Control.Monad.IO.Class (liftIO)
import Data.Functor.Identity (Identity (..))
import Data.Morpheus (App, deriveApp)
import Data.Morpheus.Server
  ( httpPubApp,
    webSocketsApp,
  )
import Data.Morpheus.Types
  ( Event (Event, channels, content),
    GQLRequest,
    GQLResponse,
    GQLType,
    Input,
    Resolver,
    RootResolver (..),
    SUBSCRIPTION,
    Undefined,
    defaultRootResolver,
    subscribe,
  )
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import GHC.Generics (Generic)
import Hasql.Connection (Connection)
import qualified Hasql.Connection as SQLC
import Hasql.Notifications (listen, toPgIdentifier, waitForNotifications)
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WebSockets as WaiWs
import Network.WebSockets (defaultConnectionOptions)
import System.IO
  ( BufferMode (LineBuffering),
    hSetBuffering,
    stdout,
  )
import Web.Scotty
  ( body,
    post,
    raw,
    scottyApp,
  )

startServer :: IO ()
startServer = do
  hSetBuffering stdout LineBuffering
  scottyServer

scottyServer :: IO ()
scottyServer = do
  putStrLn "init sql connection"
  pgConnectionEither <- SQLC.acquire (SQLC.settings "localhost" 5432 "morpheus_user_test" "p" "morpheus_user_db")
  putStrLn "init websocket app"
  (wsApp, publish) <- webSocketsApp makeApp
  case pgConnectionEither of
    Left err -> error ("erreur de connection" <> show err)
    -- spawn postgres observation in a new thread:
    -- be careful with this the connection should not be shared
    -- (as is, it's safe, because it's only used in the new thread)
    Right c -> forkIO (postgresHandler c publish)
  putStrLn "init api"
  httpApp <- app publish
  putStrLn " http listening on port 8888"
  Warp.runSettings (settings 8888) $
    WaiWs.websocketsOr defaultConnectionOptions wsApp httpApp
  where
    settings portNumber = Warp.setPort portNumber Warp.defaultSettings
    app publish =
      scottyApp $
        post "/api" $
          raw =<< (liftIO . httpPubApp makeApp publish) =<< body

data EventChannel = PgChannel | RBMQChannel
  deriving (Eq, Show)

data EventContent = Dumbo Text | WhiteRabbit Text
  deriving (Eq, Show)

type AppEvent = Event EventChannel EventContent

rootResolver :: RootResolver IO AppEvent Query Undefined Subscription
rootResolver =
  defaultRootResolver
    { queryResolver = queryInstance,
      subscriptionResolver = subscriptionInstance
    }

-- | This part is irrelevant, we only care about showcasing subscriptions, but a
-- Query instance is mandatory in 'RootResolver'.
newtype Query m = Query
  { someQuery :: m Int
  }
  deriving (Generic, GQLType)

queryInstance = Query (pure 12) -- random stuff

-- | We create a subscription which simply show an unstructured message.
newtype Subscription m = Subscription
  { listenToPostgres :: m Text
  }
  deriving (Generic, GQLType)

subscriptionInstance ::
  Subscription
    ( Resolver SUBSCRIPTION (Event EventChannel EventContent) IO
    )
subscriptionInstance =
  Subscription
    { listenToPostgres = subscribe [PgChannel] (pure subResolver)
    }
  where
    subResolver (Event [PgChannel] (Dumbo _value)) = pure _value
    subResolver _ = error "This should never execute"

makeApp :: App AppEvent IO
makeApp = deriveApp rootResolver

-- | This is the onEvent callback creator in a dedicated thread.
postgresHandler pgConnection publish = do
  putStrLn "listen to PG"
  listen pgConnection (toPgIdentifier "postgres_channel")
  waitForNotifications
    ( -- This is the actual callback of the postgres NOTIFY
      \channel content -> do
        print $ "Just got notification on channel " <> channel
        publish Event {channels = [PgChannel], content = Dumbo (decodeUtf8 content)}
    )
    pgConnection
