{-# LANGUAGE QuasiQuotes #-}

module Hasura.ClientCredentials
  ( EEClientCredentials (..),
    EEClientId (..),
    getEEClientCredentialsTx,
    setEEClientCredentialsTx,
  )
where

import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.EECredentials (EEClientCredentials (..), EEClientId (..))

getEEClientCredentialsTx :: PG.TxE QErr (Maybe EEClientCredentials)
getEEClientCredentialsTx :: TxE QErr (Maybe EEClientCredentials)
getEEClientCredentialsTx =
  (Maybe Text, Maybe Text) -> Maybe EEClientCredentials
makeClientCredentials
    ((Maybe Text, Maybe Text) -> Maybe EEClientCredentials)
-> (SingleRow (Maybe Text, Maybe Text) -> (Maybe Text, Maybe Text))
-> SingleRow (Maybe Text, Maybe Text)
-> Maybe EEClientCredentials
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Maybe Text, Maybe Text) -> (Maybe Text, Maybe Text)
forall a. SingleRow a -> a
PG.getRow
    (SingleRow (Maybe Text, Maybe Text) -> Maybe EEClientCredentials)
-> TxET QErr IO (SingleRow (Maybe Text, Maybe Text))
-> TxE QErr (Maybe EEClientCredentials)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> ()
-> Bool
-> TxET QErr IO (SingleRow (Maybe Text, Maybe Text))
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
PG.withQE
      PGTxErr -> QErr
defaultTxErrorHandler
      [PG.sql|
        SELECT ee_client_id::text, ee_client_secret
          FROM hdb_catalog.hdb_version
      |]
      ()
      Bool
False
  where
    makeClientCredentials :: (Maybe Text, Maybe Text) -> Maybe EEClientCredentials
    makeClientCredentials :: (Maybe Text, Maybe Text) -> Maybe EEClientCredentials
makeClientCredentials (Maybe Text
clientIdMaybe, Maybe Text
clientSecretMaybe) = do
      EEClientId
eccClientId <- Text -> EEClientId
EEClientId (Text -> EEClientId) -> Maybe Text -> Maybe EEClientId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
clientIdMaybe
      Text
eccClientSecret <- Maybe Text
clientSecretMaybe
      EEClientCredentials -> Maybe EEClientCredentials
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EEClientCredentials {Text
EEClientId
eccClientId :: EEClientId
eccClientSecret :: Text
eccClientId :: EEClientId
eccClientSecret :: Text
..}

setEEClientCredentialsTx :: EEClientCredentials -> PG.TxE QErr ()
setEEClientCredentialsTx :: EEClientCredentials -> TxE QErr ()
setEEClientCredentialsTx EEClientCredentials {Text
EEClientId
eccClientId :: EEClientCredentials -> EEClientId
eccClientSecret :: EEClientCredentials -> Text
eccClientId :: EEClientId
eccClientSecret :: Text
..} =
  (PGTxErr -> QErr) -> Query -> (Text, Text) -> Bool -> TxE QErr ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
PG.unitQE
    PGTxErr -> QErr
defaultTxErrorHandler
    [PG.sql|
      UPDATE hdb_catalog.hdb_version
        SET ee_client_id = $1,
            ee_client_secret = $2
    |]
    (EEClientId -> Text
_getEEClientId EEClientId
eccClientId, Text
eccClientSecret)
    Bool
True