content: module PostgREST.Admin
    ( runAdmin
    ) where
  
  import qualified Data.Aeson                as JSON
  import qualified Network.HTTP.Types.Status as HTTP
  import qualified Network.Wai               as Wai
  import qualified Network.Wai.Handler.Warp  as Warp
  
  import Control.Monad.Extra       (whenJust)
  import Network.Socket            hiding (addrFamily)
  import Network.Socket.ByteString
  
  import PostgREST.AppState    (AppState)
  import PostgREST.MediaType   (MediaType (..), toContentType)
  import PostgREST.Metrics     (metricsToText)
  import PostgREST.Network     (resolveSocketToAddress)
  import PostgREST.Observation (Observation (..))
  
  import qualified PostgREST.AppState as AppState
  
  import Protolude
  
  runAdmin :: AppState -> Warp.Settings -> IO ()
  runAdmin appState settings = do
    whenJust (AppState.getSocketAdmin appState) $ \adminSocket -> do
      address <- resolveSocketToAddress adminSocket
      observer $ AdminStartObs address
      void . forkIO $ Warp.runSettingsSocket settings adminSocket adminApp
    where
      adminApp = admin appState
      observer = AppState.getObserver appState
  
  -- | PostgREST admin application
  admin :: AppState.AppState -> Wai.Application
  admin appState req respond  = do
    isMainAppReachable  <- isRight <$> reachMainApp (AppState.getSocketREST appState)
    isLoaded <- AppState.isLoaded appState
    isPending <- AppState.isPending appState
  
    case Wai.pathInfo req of
      ["live"] ->
        respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status500) [] mempty
      ["ready"] ->
        let
          status | not isMainAppReachable = HTTP.status500
                 | isPending              = HTTP.status503
                 | isLoaded               = HTTP.status200
                 | otherwise              = HTTP.status500
        in
        respond $ Wai.responseLBS status [] mempty
      ["schema_cache"] -> do
        sCache <- AppState.getSchemaCache appState
        respond $ Wai.responseLBS HTTP.status200 [] (maybe mempty JSON.encode sCache)
      ["metrics"] -> do
        mets <- metricsToText
        respond $ Wai.responseLBS HTTP.status200 [toContentType MTTextPlain] mets -- Content-Type is required for prometheus compliance
      _ ->
        respond $ Wai.responseLBS HTTP.status404 [] mempty
  
  -- Try to connect to the main app socket
  -- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
  reachMainApp :: Socket -> IO (Either IOException ())
  reachMainApp appSock = do
    sockAddr <- getSocketName appSock
    sock <- socket (addrFamily sockAddr) Stream defaultProtocol
    try $ do
      connect sock sockAddr
      withSocketsDo $ bracket (pure sock) close sendEmpty
    where
      sendEmpty sock = void $ send sock mempty
      addrFamily (SockAddrInet _ _) = AF_INET
      addrFamily (SockAddrInet6 {}) = AF_INET6
      addrFamily (SockAddrUnix _)   = AF_UNIX
  