{-| A postgresql connection options type and related functions. -}

module Database.PostgreSQL.Simple.Options
  ( Options(..)
  , defaultOptions
  , toConnectionString
  , parseConnectionString
  ) where
import Data.Maybe (Maybe, maybeToList)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Data.Monoid.Generic
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Text.Read (readMaybe)
import URI.ByteString as URI
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Monoid
import Control.Monad ((<=<), foldM)
import Control.Applicative

-- | A postgresql connection options type.
data Options = Options
  { Options -> Last String
host                    :: Last String
  , Options -> Last String
hostaddr                :: Last String
  , Options -> Last Int
port                    :: Last Int
  , Options -> Last String
user                    :: Last String
  , Options -> Last String
password                :: Last String
  , Options -> Last String
dbname                  :: Last String
  , Options -> Last Int
connectTimeout          :: Last Int
  , Options -> Last String
clientEncoding          :: Last String
  , Options -> Last String
options                 :: Last String
  , Options -> Last String
fallbackApplicationName :: Last String
  , Options -> Last Int
keepalives              :: Last Int
  , Options -> Last Int
keepalivesIdle          :: Last Int
  , Options -> Last Int
keepalivesCount         :: Last Int
  , Options -> Last String
sslmode                 :: Last String
  , Options -> Last Int
requiressl              :: Last Int
  , Options -> Last Int
sslcompression          :: Last Int
  , Options -> Last String
sslcert                 :: Last String
  , Options -> Last String
sslkey                  :: Last String
  , Options -> Last String
sslrootcert             :: Last String
  , Options -> Last String
requirepeer             :: Last String
  , Options -> Last String
krbsrvname              :: Last String
  , Options -> Last String
gsslib                  :: Last String
  , Options -> Last String
service                 :: Last String
  } deriving stock (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> String
show :: Options -> String
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show, Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
/= :: Options -> Options -> Bool
Eq, ReadPrec [Options]
ReadPrec Options
Int -> ReadS Options
ReadS [Options]
(Int -> ReadS Options)
-> ReadS [Options]
-> ReadPrec Options
-> ReadPrec [Options]
-> Read Options
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Options
readsPrec :: Int -> ReadS Options
$creadList :: ReadS [Options]
readList :: ReadS [Options]
$creadPrec :: ReadPrec Options
readPrec :: ReadPrec Options
$creadListPrec :: ReadPrec [Options]
readListPrec :: ReadPrec [Options]
Read, Eq Options
Eq Options =>
(Options -> Options -> Ordering)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Options)
-> (Options -> Options -> Options)
-> Ord Options
Options -> Options -> Bool
Options -> Options -> Ordering
Options -> Options -> Options
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Options -> Options -> Ordering
compare :: Options -> Options -> Ordering
$c< :: Options -> Options -> Bool
< :: Options -> Options -> Bool
$c<= :: Options -> Options -> Bool
<= :: Options -> Options -> Bool
$c> :: Options -> Options -> Bool
> :: Options -> Options -> Bool
$c>= :: Options -> Options -> Bool
>= :: Options -> Options -> Bool
$cmax :: Options -> Options -> Options
max :: Options -> Options -> Options
$cmin :: Options -> Options -> Options
min :: Options -> Options -> Options
Ord, (forall x. Options -> Rep Options x)
-> (forall x. Rep Options x -> Options) -> Generic Options
forall x. Rep Options x -> Options
forall x. Options -> Rep Options x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Options -> Rep Options x
from :: forall x. Options -> Rep Options x
$cto :: forall x. Rep Options x -> Options
to :: forall x. Rep Options x -> Options
Generic, Typeable)
    deriving NonEmpty Options -> Options
Options -> Options -> Options
(Options -> Options -> Options)
-> (NonEmpty Options -> Options)
-> (forall b. Integral b => b -> Options -> Options)
-> Semigroup Options
forall b. Integral b => b -> Options -> Options
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Options -> Options -> Options
<> :: Options -> Options -> Options
$csconcat :: NonEmpty Options -> Options
sconcat :: NonEmpty Options -> Options
$cstimes :: forall b. Integral b => b -> Options -> Options
stimes :: forall b. Integral b => b -> Options -> Options
Semigroup via GenericSemigroup Options
    deriving Semigroup Options
Options
Semigroup Options =>
Options
-> (Options -> Options -> Options)
-> ([Options] -> Options)
-> Monoid Options
[Options] -> Options
Options -> Options -> Options
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Options
mempty :: Options
$cmappend :: Options -> Options -> Options
mappend :: Options -> Options -> Options
$cmconcat :: [Options] -> Options
mconcat :: [Options] -> Options
Monoid    via GenericMonoid Options

-- | Make a key value postgresql option string.
toConnectionString :: Options -> ByteString
toConnectionString :: Options -> ByteString
toConnectionString Options {Last Int
Last String
host :: Options -> Last String
hostaddr :: Options -> Last String
port :: Options -> Last Int
user :: Options -> Last String
password :: Options -> Last String
dbname :: Options -> Last String
connectTimeout :: Options -> Last Int
clientEncoding :: Options -> Last String
options :: Options -> Last String
fallbackApplicationName :: Options -> Last String
keepalives :: Options -> Last Int
keepalivesIdle :: Options -> Last Int
keepalivesCount :: Options -> Last Int
sslmode :: Options -> Last String
requiressl :: Options -> Last Int
sslcompression :: Options -> Last Int
sslcert :: Options -> Last String
sslkey :: Options -> Last String
sslrootcert :: Options -> Last String
requirepeer :: Options -> Last String
krbsrvname :: Options -> Last String
gsslib :: Options -> Last String
service :: Options -> Last String
host :: Last String
hostaddr :: Last String
port :: Last Int
user :: Last String
password :: Last String
dbname :: Last String
connectTimeout :: Last Int
clientEncoding :: Last String
options :: Last String
fallbackApplicationName :: Last String
keepalives :: Last Int
keepalivesIdle :: Last Int
keepalivesCount :: Last Int
sslmode :: Last String
requiressl :: Last Int
sslcompression :: Last Int
sslcert :: Last String
sslkey :: Last String
sslrootcert :: Last String
requirepeer :: Last String
krbsrvname :: Last String
gsslib :: Last String
service :: Last String
..} = String -> ByteString
BSC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> String
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
v)
  ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$  String -> Last String -> [(String, String)]
maybeToPairStr String
"host" Last String
host
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"hostaddr" Last String
hostaddr
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"dbname" Last String
dbname
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"port" Last Int
port
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"password" Last String
password
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"user" Last String
user
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"connect_timeout" Last Int
connectTimeout
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"client_encoding" Last String
clientEncoding
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"options" Last String
options
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"fallback_applicationName" Last String
fallbackApplicationName
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"keepalives" Last Int
keepalives
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"keepalives_idle" Last Int
keepalivesIdle
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"keepalives_count" Last Int
keepalivesCount
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslmode" Last String
sslmode
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"requiressl" Last Int
requiressl
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last Int -> [(String, String)]
forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
"sslcompression" Last Int
sslcompression
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslcert" Last String
sslcert
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslkey" Last String
sslkey
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"sslrootcert" Last String
sslrootcert
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"requirepeer" Last String
requirepeer
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"krbsrvname" Last String
krbsrvname
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"gsslib" Last String
gsslib
  [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> String -> Last String -> [(String, String)]
maybeToPairStr String
"service" Last String
service
  where
  maybeToPairStr :: String -> Last String -> [(String, String)]
  maybeToPairStr :: String -> Last String -> [(String, String)]
maybeToPairStr String
k Last String
mv = (String
k,) (String -> (String, String)) -> [String] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Last String -> Maybe String
forall a. Last a -> Maybe a
getLast Last String
mv)

  maybeToPair :: Show a => String -> Last a -> [(String, String)]
  maybeToPair :: forall a. Show a => String -> Last a -> [(String, String)]
maybeToPair String
k Last a
mv = (\a
v -> (String
k, a -> String
forall a. Show a => a -> String
show a
v)) (a -> (String, String)) -> [a] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Last a -> Maybe a
forall a. Last a -> Maybe a
getLast Last a
mv)

{-| Default options.

 @
   defaultOptions :: Options
   defaultOptions = mempty
    { host     = pure "localhost"
    , port     = pure 5432
    , user     = pure "postgres"
    , dbname   = pure "postgres"
    }
 @
-}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
forall a. Monoid a => a
mempty
  { host     = pure "localhost"
  , port     = pure 5432
  , user     = pure "postgres"
  , dbname   = pure "postgres"
  }

userInfoToptions :: UserInfo -> Options
userInfoToptions :: UserInfo -> Options
userInfoToptions UserInfo {ByteString
uiUsername :: ByteString
uiPassword :: ByteString
uiUsername :: UserInfo -> ByteString
uiPassword :: UserInfo -> ByteString
..} = Options
forall a. Monoid a => a
mempty { user = return $ BSC.unpack uiUsername } Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<> if ByteString -> Bool
BS.null ByteString
uiPassword
  then Options
forall a. Monoid a => a
mempty
  else Options
forall a. Monoid a => a
mempty { password = return $ BSC.unpack uiPassword }

authorityToOptions :: Authority -> Options
authorityToOptions :: Authority -> Options
authorityToOptions Authority {Maybe UserInfo
Maybe Port
Host
authorityUserInfo :: Maybe UserInfo
authorityHost :: Host
authorityPort :: Maybe Port
authorityUserInfo :: Authority -> Maybe UserInfo
authorityHost :: Authority -> Host
authorityPort :: Authority -> Maybe Port
..} = Options -> (UserInfo -> Options) -> Maybe UserInfo -> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
forall a. Monoid a => a
mempty UserInfo -> Options
userInfoToptions Maybe UserInfo
authorityUserInfo Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<>
  Options
forall a. Monoid a => a
mempty { host = return $ BSC.unpack $ hostBS authorityHost } Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<>
  Options -> (Port -> Options) -> Maybe Port -> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
forall a. Monoid a => a
mempty (\Port
p -> Options
forall a. Monoid a => a
mempty { port = return $ portNumber p }) Maybe Port
authorityPort

pathToptions :: ByteString -> Options
pathToptions :: ByteString -> Options
pathToptions ByteString
path = case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
path of
  String
"" -> Options
forall a. Monoid a => a
mempty
  String
x  -> Options
forall a. Monoid a => a
mempty {dbname = return x }

parseInt :: String -> String -> Either String Int
parseInt :: String -> String -> Either String Int
parseInt String
msg String
v = Either String Int
-> (Int -> Either String Int) -> Maybe Int -> Either String Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Int
forall a b. a -> Either a b
Left (String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" value of: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
v String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a number")) Int -> Either String Int
forall a b. b -> Either a b
Right (Maybe Int -> Either String Int) -> Maybe Int -> Either String Int
forall a b. (a -> b) -> a -> b
$
      String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
v

parseString :: String -> Maybe String
parseString :: String -> Maybe String
parseString String
x = String -> Maybe String
forall a. Read a => String -> Maybe a
readMaybe String
x Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
unSingleQuote String
x Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
forall a. a -> Maybe a
Just String
x

unSingleQuote :: String -> Maybe String
unSingleQuote :: String -> Maybe String
unSingleQuote (Char
x : xs :: String
xs@(Char
_ : String
_))
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. HasCallStack => [a] -> [a]
init String
xs
  | Bool
otherwise                    = Maybe String
forall a. Maybe a
Nothing
unSingleQuote String
_                  = Maybe String
forall a. Maybe a
Nothing

keywordToptions :: String -> String -> Either String Options
keywordToptions :: String -> String -> Either String Options
keywordToptions String
k String
v = case String
k of
  String
"host" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { host = return v }
  String
"hostaddress" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { hostaddr = return v }
  String
"port" -> do
    Int
portValue <- String -> String -> Either String Int
parseInt String
"port" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { port = return portValue }
  String
"user" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { user = return v }
  String
"password" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { password = return v }
  String
"dbname" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { dbname = return v}
  String
"connect_timeout" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"connect_timeout" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { connectTimeout = return x }
  String
"client_encoding" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { clientEncoding = return v }
  String
"options" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { options = return v }
  String
"fallback_applicationName" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { fallbackApplicationName = return v }
  String
"keepalives" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"keepalives" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { keepalives = return x }
  String
"keepalives_idle" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"keepalives_idle" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { keepalivesIdle = return x }
  String
"keepalives_count" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"keepalives_count" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { keepalivesCount = return x }
  String
"sslmode" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { sslmode = return v }
  String
"requiressl" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"requiressl" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { requiressl = return x }
  String
"sslcompression" -> do
    Int
x <- String -> String -> Either String Int
parseInt String
"sslcompression" String
v
    Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { sslcompression = return x }
  String
"sslcert" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { sslcert = return v }
  String
"sslkey" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { sslkey = return v }
  String
"sslrootcert" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { sslrootcert = return v }
  String
"requirepeer" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { requirepeer = return v }
  String
"krbsrvname" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { krbsrvname = return v }
  String
"gsslib" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { gsslib = return v }
  String
"service" -> Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options
forall a. Monoid a => a
mempty { service = return v }

  String
x -> String -> Either String Options
forall a b. a -> Either a b
Left (String -> Either String Options)
-> String -> Either String Options
forall a b. (a -> b) -> a -> b
$ String
"Unrecongnized option: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x

queryToptions :: URI.Query -> Either String Options
queryToptions :: Query -> Either String Options
queryToptions Query {[(ByteString, ByteString)]
queryPairs :: [(ByteString, ByteString)]
queryPairs :: Query -> [(ByteString, ByteString)]
..} = (Options -> (ByteString, ByteString) -> Either String Options)
-> Options -> [(ByteString, ByteString)] -> Either String Options
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Options
acc (ByteString
k, ByteString
v) -> (Options -> Options)
-> Either String Options -> Either String Options
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Options -> Options -> Options
forall a. Monoid a => a -> a -> a
mappend Options
acc) (Either String Options -> Either String Options)
-> Either String Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ String -> String -> Either String Options
keywordToptions (ByteString -> String
BSC.unpack ByteString
k) (String -> Either String Options)
-> String -> Either String Options
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
v) Options
forall a. Monoid a => a
mempty [(ByteString, ByteString)]
queryPairs

uriToptions :: URIRef Absolute -> Either String Options
uriToptions :: URIRef Absolute -> Either String Options
uriToptions URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriScheme :: Scheme
uriAuthority :: Maybe Authority
uriPath :: ByteString
uriQuery :: Query
uriFragment :: Maybe ByteString
uriScheme :: URIRef Absolute -> Scheme
uriAuthority :: URIRef Absolute -> Maybe Authority
uriPath :: URIRef Absolute -> ByteString
uriQuery :: URIRef Absolute -> Query
uriFragment :: URIRef Absolute -> Maybe ByteString
..} = case Scheme -> ByteString
schemeBS Scheme
uriScheme of
  ByteString
"postgres" -> Either String Options
options
  ByteString
"postgresql" -> Either String Options
options
  ByteString
x -> String -> Either String Options
forall a b. a -> Either a b
Left (String -> Either String Options)
-> String -> Either String Options
forall a b. (a -> b) -> a -> b
$ String
"Wrong protocol. Expected \"postgres\" or \"postgresql\" but got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x
  where
    options :: Either String Options
options = do
      Options
queryParts <- Query -> Either String Options
queryToptions Query
uriQuery
      Options -> Either String Options
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Either String Options)
-> Options -> Either String Options
forall a b. (a -> b) -> a -> b
$ Options -> (Authority -> Options) -> Maybe Authority -> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
forall a. Monoid a => a
mempty Authority -> Options
authorityToOptions Maybe Authority
uriAuthority Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<>
        ByteString -> Options
pathToptions ByteString
uriPath Options -> Options -> Options
forall a. Semigroup a => a -> a -> a
<> Options
queryParts

parseURIStr :: String -> Either String (URIRef Absolute)
parseURIStr :: String -> Either String (URIRef Absolute)
parseURIStr = (URIParseError -> String)
-> Either URIParseError (URIRef Absolute)
-> Either String (URIRef Absolute)
forall {t} {a} {b}. (t -> a) -> Either t b -> Either a b
left URIParseError -> String
forall a. Show a => a -> String
show (Either URIParseError (URIRef Absolute)
 -> Either String (URIRef Absolute))
-> (String -> Either URIParseError (URIRef Absolute))
-> String
-> Either String (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions (ByteString -> Either URIParseError (URIRef Absolute))
-> (String -> ByteString)
-> String
-> Either URIParseError (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack where
  left :: (t -> a) -> Either t b -> Either a b
left t -> a
f = \case
    Left t
x -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ t -> a
f t
x
    Right b
x -> b -> Either a b
forall a b. b -> Either a b
Right b
x

parseKeywords :: String -> Either String Options
parseKeywords :: String -> Either String Options
parseKeywords [] = String -> Either String Options
forall a b. a -> Either a b
Left String
"Failed to parse keywords"
parseKeywords String
x = ([Options] -> Options)
-> Either String [Options] -> Either String Options
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Options] -> Options
forall a. Monoid a => [a] -> a
mconcat (Either String [Options] -> Either String Options)
-> ([String] -> Either String [Options])
-> [String]
-> Either String Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either String Options)
-> [String] -> Either String [Options]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((String -> String -> Either String Options)
-> (String, String) -> Either String Options
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Either String Options
keywordToptions ((String, String) -> Either String Options)
-> (String -> Either String (String, String))
-> String
-> Either String Options
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [String] -> Either String (String, String)
toTuple ([String] -> Either String (String, String))
-> (String -> [String]) -> String -> Either String (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"=") ([String] -> Either String Options)
-> [String] -> Either String Options
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
x where
  toTuple :: [String] -> Either String (String, String)
toTuple [String
k, String
v] = (String, String) -> Either String (String, String)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
k, String
v)
  toTuple [String]
xs = String -> Either String (String, String)
forall a b. a -> Either a b
Left (String -> Either String (String, String))
-> String -> Either String (String, String)
forall a b. (a -> b) -> a -> b
$ String
"invalid opts:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"=" [String]
xs)

-- | Parse a connection string. Can be in URI or keyword format.
parseConnectionString :: String -> Either String Options
parseConnectionString :: String -> Either String Options
parseConnectionString String
url = do
  String
url' <- Either String String
-> (String -> Either String String)
-> Maybe String
-> Either String String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String String
forall a b. a -> Either a b
Left String
"failed to parse as string") String -> Either String String
forall a b. b -> Either a b
Right (Maybe String -> Either String String)
-> Maybe String -> Either String String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
parseString String
url
  Either String Options
-> Either String Options -> Either String Options
forall {a} {b}. Either a b -> Either a b -> Either a b
or (String -> Either String Options
parseKeywords String
url') (URIRef Absolute -> Either String Options
uriToptions (URIRef Absolute -> Either String Options)
-> Either String (URIRef Absolute) -> Either String Options
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Either String (URIRef Absolute)
parseURIStr String
url')
  where
    or :: Either a b -> Either a b -> Either a b
or (Left a
_) Either a b
n = Either a b
n
    or Either a b
m        Either a b
_ = Either a b
m