UserQuery.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.PostgreSQL.UserQuery () where

import Data.Text qualified as T
import Hasql.Decoders as D
import Hasql.Encoders as E
import Hasql.Pool qualified
import Hasql.Session qualified as Session
import Hasql.Statement (Statement (..))
import NeatInterpolation
import Optics
import Relude
import WikiMusic.Free.UserQuery
import WikiMusic.Protolude

instance Exec UserQuery where
  execAlgebra (DoesTokenMatchByEmail env email token next) = next =<< doesTokenMatchByEmail' env email token

doesTokenMatchByEmail' :: (MonadIO m) => Env -> UserEmail -> UserToken -> m (Either UserQueryError Bool)
doesTokenMatchByEmail' env email token = do
  maybeFoundByEmail <- liftIO $ Hasql.Pool.use (env ^. #pool) (Session.statement (email ^. #value) stmt)
  let maybeTokenToCompare = first (PersistenceError . T.pack . show) maybeFoundByEmail
  maybeTokenToCompare & either (pure . Left) (pure . Right . (Just (token ^. #value) ==))
  where
    stmt = Statement query encoder decoder True
    encoder = E.param . E.nonNullable $ E.text
    decoder = D.rowMaybe $ D.column . D.nonNullable $ D.text
    query =
      encodeUtf8
        [trimming|
          SELECT password_reset_token FROM users WHERE email_address = $$1 LIMIT 1
          |]