-- | Coverage for 'Pqi.connectdb': a blocking connection from a conninfo
-- string, including the rejected-conninfo error paths and SCRAM-SHA-256
-- authentication.
module Pqi.Conformance.Operation.Connectdb
  ( spec,
  )
where

import Control.Exception (bracket)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as ByteString.Char8
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Pqi
import Pqi.Conformance.Harness
import Pqi.Conformance.Observation
import Pqi.Conformance.Prelude
import qualified Pqi.Conformance.Reference as Reference
import Test.Hspec
import qualified TestcontainersPostgresql as TcPg

spec :: Pqi.Adapter -> SpecWith ByteString
spec :: Adapter -> SpecWith ByteString
spec Adapter
adapter = do
  [Char] -> SpecWith ByteString -> SpecWith ByteString
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"connectdb" do
    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"opens a usable connection" \ByteString
conninfo ->
      Adapter
-> ByteString -> (Connection -> IO ConnectionObservation) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Connection -> IO a) -> IO ()
differential Adapter
adapter ByteString
conninfo Connection -> IO ConnectionObservation
observeConnection

    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"accepts a URI-format conninfo" \ByteString
conninfo ->
      Adapter
-> ByteString -> (Adapter -> ByteString -> IO ConnStatus) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Adapter -> ByteString -> IO a) -> IO ()
differentialConnect Adapter
adapter ByteString
conninfo \Adapter
adapter' ByteString
conninfo' -> do
        connection <- Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter' (ByteString -> ByteString
kvToUri ByteString
conninfo')
        s <- Pqi.status connection
        Pqi.finish connection
        pure s

    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"rejects an unknown database" \ByteString
conninfo ->
      Adapter
-> ByteString
-> (Adapter -> ByteString -> IO (ConnStatus, Bool))
-> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Adapter -> ByteString -> IO a) -> IO ()
differentialConnect Adapter
adapter ByteString
conninfo \Adapter
adapter' ByteString
conninfo' -> do
        connection <- Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter' (ByteString
conninfo' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" dbname=pqi_no_such_db")
        observation <- Pqi.status connection
        nullness <- pure (Pqi.isNullConnection connection)
        Pqi.finish connection
        pure (observation, nullness)

    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"rejects an unknown user" \ByteString
conninfo ->
      Adapter
-> ByteString -> (Adapter -> ByteString -> IO ConnStatus) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Adapter -> ByteString -> IO a) -> IO ()
differentialConnect Adapter
adapter ByteString
conninfo \Adapter
adapter' ByteString
conninfo' -> do
        connection <- Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter' (ByteString
conninfo' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" user=pqi_no_such_user")
        observation <- Pqi.status connection
        Pqi.finish connection
        pure observation

    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"defaults the user like the reference when user is omitted" \ByteString
conninfo ->
      Adapter
-> ByteString
-> (Adapter
    -> ByteString
    -> IO (Maybe ByteString, ConnStatus, Maybe ByteString))
-> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Adapter -> ByteString -> IO a) -> IO ()
differentialConnect Adapter
adapter ByteString
conninfo \Adapter
adapter' ByteString
conninfo' -> do
        connection <- Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter' (ByteString -> ByteString
dropUser ByteString
conninfo')
        resolvedUser <- Pqi.user connection
        observedStatus <- Pqi.status connection
        observedError <- Pqi.errorMessage connection
        Pqi.finish connection
        pure (resolvedUser, observedStatus, observedError)

    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"forwards extra conninfo params like the reference (e.g. application_name)" \ByteString
conninfo ->
      Adapter
-> ByteString
-> (Adapter -> ByteString -> IO (Maybe ByteString))
-> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Adapter -> ByteString -> IO a) -> IO ()
differentialConnect Adapter
adapter ByteString
conninfo \Adapter
adapter' ByteString
conninfo' -> do
        connection <- Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter' (ByteString
conninfo' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" application_name=pqi-conformance-test")
        observedApplicationName <- Pqi.parameterStatus connection "application_name"
        Pqi.finish connection
        pure observedApplicationName

  [Char] -> SpecWith ByteString -> SpecWith ByteString
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"SCRAM-SHA-256 authentication" do
    [Char]
-> (ByteString -> IO ()) -> SpecWith (Arg (ByteString -> IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"the candidate authenticates and queries like the FFI reference" \ByteString
_ ->
      let scramConfig :: Config
scramConfig =
            TcPg.Config
              { tagName :: Text
TcPg.tagName = Text
"postgres:17",
                forwardLogs :: Bool
TcPg.forwardLogs = Bool
False,
                auth :: Auth
TcPg.auth = Text -> Text -> Auth
TcPg.CredentialsAuth Text
"scram" Text
"secret"
              }

          scramScenario :: Pqi.Connection -> IO (Maybe ResultObservation)
          scramScenario :: Connection -> IO (Maybe ResultObservation)
scramScenario Connection
connection = Connection -> ByteString -> IO (Maybe Result)
Pqi.exec Connection
connection ByteString
"select 1 as scram_works" IO (Maybe Result)
-> (Maybe Result -> IO (Maybe ResultObservation))
-> IO (Maybe ResultObservation)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Result -> IO ResultObservation)
-> Maybe Result -> IO (Maybe ResultObservation)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Result -> IO ResultObservation
observeResult
       in Config -> ((Text, Word16) -> IO ()) -> IO ()
TcPg.run Config
scramConfig \(Text
host, Word16
port) -> do
            let conninfo :: ByteString
conninfo =
                  [Char] -> ByteString
ByteString.Char8.pack
                    ( [Char]
"host="
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
host
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" port="
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
port
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" user=scram password=secret dbname=scram"
                    )
            candidate <- IO Connection
-> (Connection -> IO ())
-> (Connection -> IO (Maybe ResultObservation))
-> IO (Maybe ResultObservation)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter ByteString
conninfo) Connection -> IO ()
Pqi.finish Connection -> IO (Maybe ResultObservation)
scramScenario
            reference <- bracket (Pqi.connectdb Reference.adapter conninfo) Pqi.finish scramScenario
            candidate `shouldBe` reference

-- | Drop the @user=…@ token from a @key=value@ conninfo, leaving the user
-- unspecified so the adapter must apply its own default. libpq derives the
-- default from the operating-system login name; an adapter that hardcodes a
-- different default (e.g. @postgres@) diverges here.
dropUser :: ByteString -> ByteString
dropUser :: ByteString -> ByteString
dropUser ByteString
raw =
  [ByteString] -> ByteString
ByteString.Char8.unwords
    ((ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"user=" ByteString -> ByteString -> Bool
`ByteString.isPrefixOf`)) (ByteString -> [ByteString]
ByteString.Char8.words ByteString
raw))

-- | Convert a @key=value@ conninfo to a @postgresql://@ URI, for testing
-- that adapters accept URI-format connection strings.
kvToUri :: ByteString -> ByteString
kvToUri :: ByteString -> ByteString
kvToUri ByteString
raw =
  ByteString
"postgresql://"
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
user
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if ByteString -> Bool
ByteString.null ByteString
password then ByteString
"" else ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
password)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if ByteString -> Bool
ByteString.null ByteString
user Bool -> Bool -> Bool
&& ByteString -> Bool
ByteString.null ByteString
password then ByteString
"" else ByteString
"@")
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
host
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if ByteString -> Bool
ByteString.null ByteString
port then ByteString
"" else ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
port)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if ByteString -> Bool
ByteString.null ByteString
dbname then ByteString
"" else ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
dbname)
  where
    pairs :: Map ByteString ByteString
pairs = [(ByteString, ByteString)] -> Map ByteString ByteString
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, ByteString)] -> Map ByteString ByteString)
-> [(ByteString, ByteString)] -> Map ByteString ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe (ByteString, ByteString)
toPair (ByteString -> [ByteString]
ByteString.Char8.words ByteString
raw)
    get :: ByteString -> ByteString
get ByteString
k = ByteString -> ByteString -> Map ByteString ByteString -> ByteString
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ByteString
"" ByteString
k Map ByteString ByteString
pairs
    toPair :: ByteString -> Maybe (ByteString, ByteString)
toPair ByteString
token = case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.Char8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') ByteString
token of
      (ByteString
k, ByteString
v) | Bool -> Bool
not (ByteString -> Bool
ByteString.null ByteString
v) -> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
k, Int -> ByteString -> ByteString
ByteString.drop Int
1 ByteString
v)
      (ByteString, ByteString)
_ -> Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
    host :: ByteString
host = ByteString -> ByteString
get ByteString
"host"
    port :: ByteString
port = ByteString -> ByteString
get ByteString
"port"
    user :: ByteString
user = ByteString -> ByteString
get ByteString
"user"
    password :: ByteString
password = ByteString -> ByteString
get ByteString
"password"
    dbname :: ByteString
dbname = ByteString -> ByteString
get ByteString
"dbname"