{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Hasql.URL
-- Description : Parses a postgresql connection string into a Hasql Settings
-- License     : MIT
--
-- Maintainer  : Nadeem Bitar <nadeem@gmail.com>
--
--
-- This is a direct port of [postgresql-simple-url](https://hackage.haskell.org/package/postgresql-simple-url) to Hasql.
module Hasql.URL
  ( parseDatabaseUrl,
  )
where

import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import Data.List.Split
import Data.Word (Word16)
import Hasql.Connection (Settings, settings)
import Network.URI

data ConnectionInfo = ConnectionInfo
  { ConnectionInfo -> Word16
_port :: Word16,
    ConnectionInfo -> ByteString
_username :: ByteString,
    ConnectionInfo -> ByteString
_host :: ByteString,
    ConnectionInfo -> ByteString
_password :: ByteString,
    ConnectionInfo -> ByteString
_database :: ByteString
  }
  deriving stock (Int -> ConnectionInfo -> ShowS
[ConnectionInfo] -> ShowS
ConnectionInfo -> String
(Int -> ConnectionInfo -> ShowS)
-> (ConnectionInfo -> String)
-> ([ConnectionInfo] -> ShowS)
-> Show ConnectionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionInfo] -> ShowS
$cshowList :: [ConnectionInfo] -> ShowS
show :: ConnectionInfo -> String
$cshow :: ConnectionInfo -> String
showsPrec :: Int -> ConnectionInfo -> ShowS
$cshowsPrec :: Int -> ConnectionInfo -> ShowS
Show)

defaultConnectionInfo :: ConnectionInfo
defaultConnectionInfo :: ConnectionInfo
defaultConnectionInfo = Word16
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ConnectionInfo
ConnectionInfo Word16
5432 ByteString
"postgres" ByteString
"" ByteString
"" ByteString
""

-- | Parse a string postgresql url into `Hasql.Connection.Settings`
--
-- @
-- parseDatabaseUrl \"postgres://username:password@domain.com:5433/database\" ==
-- Just $ settings \"domain.com\" (fromInteger 5433) \"username\" \"password\" \"database\"
-- @
parseDatabaseUrl :: String -> Maybe Settings
parseDatabaseUrl :: String -> Maybe ByteString
parseDatabaseUrl String
databaseUrl = String -> Maybe URI
parseURI String
databaseUrl Maybe URI -> (URI -> Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= URI -> Maybe ByteString
uriToSettings

uriToSettings :: URI -> Maybe Settings
uriToSettings :: URI -> Maybe ByteString
uriToSettings URI
uri
  | URI -> String
uriScheme URI
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"postgres:" Bool -> Bool -> Bool
&& URI -> String
uriScheme URI
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"postgresql:" = Maybe ByteString
forall a. Maybe a
Nothing
  | Bool
otherwise = ConnectionInfo -> ByteString
mkSettingsFromConnectionInfo (ConnectionInfo -> ByteString)
-> ((ConnectionInfo -> ConnectionInfo) -> ConnectionInfo)
-> (ConnectionInfo -> ConnectionInfo)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConnectionInfo -> ConnectionInfo)
-> ConnectionInfo -> ConnectionInfo
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
defaultConnectionInfo) ((ConnectionInfo -> ConnectionInfo) -> ByteString)
-> Maybe (ConnectionInfo -> ConnectionInfo) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe (ConnectionInfo -> ConnectionInfo)
mkConnectionInfo URI
uri

mkSettingsFromConnectionInfo :: ConnectionInfo -> Settings
mkSettingsFromConnectionInfo :: ConnectionInfo -> ByteString
mkSettingsFromConnectionInfo ConnectionInfo
u = ByteString
-> Word16 -> ByteString -> ByteString -> ByteString -> ByteString
settings (ConnectionInfo -> ByteString
_host ConnectionInfo
u) (ConnectionInfo -> Word16
_port ConnectionInfo
u) (ConnectionInfo -> ByteString
_username ConnectionInfo
u) (ConnectionInfo -> ByteString
_password ConnectionInfo
u) (ConnectionInfo -> ByteString
_database ConnectionInfo
u)

dropLast :: [a] -> [a]
dropLast :: [a] -> [a]
dropLast [] = []
dropLast [a]
l = [a] -> [a]
forall a. [a] -> [a]
init [a]
l

mkConnectionInfo :: URI -> Maybe (ConnectionInfo -> ConnectionInfo)
mkConnectionInfo :: URI -> Maybe (ConnectionInfo -> ConnectionInfo)
mkConnectionInfo URI
uri = case URI -> String
uriPath URI
uri of
  (Char
'/' : String
rest) | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) -> (ConnectionInfo -> ConnectionInfo)
-> Maybe (ConnectionInfo -> ConnectionInfo)
forall a. a -> Maybe a
Just ((ConnectionInfo -> ConnectionInfo)
 -> Maybe (ConnectionInfo -> ConnectionInfo))
-> (ConnectionInfo -> ConnectionInfo)
-> Maybe (ConnectionInfo -> ConnectionInfo)
forall a b. (a -> b) -> a -> b
$ URI -> ConnectionInfo -> ConnectionInfo
uriParameters URI
uri
  String
_ -> Maybe (ConnectionInfo -> ConnectionInfo)
forall a. Maybe a
Nothing

uriParameters :: URI -> (ConnectionInfo -> ConnectionInfo)
uriParameters :: URI -> ConnectionInfo -> ConnectionInfo
uriParameters URI
uri = (\ConnectionInfo
info -> ConnectionInfo
info {_database :: ByteString
_database = String -> ByteString
pack (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
tail (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath URI
uri}) (ConnectionInfo -> ConnectionInfo)
-> (ConnectionInfo -> ConnectionInfo)
-> ConnectionInfo
-> ConnectionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnectionInfo -> ConnectionInfo)
-> (URIAuth -> ConnectionInfo -> ConnectionInfo)
-> Maybe URIAuth
-> ConnectionInfo
-> ConnectionInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConnectionInfo -> ConnectionInfo
forall a. a -> a
id URIAuth -> ConnectionInfo -> ConnectionInfo
uriAuthParameters (URI -> Maybe URIAuth
uriAuthority URI
uri)

uriAuthParameters :: URIAuth -> (ConnectionInfo -> ConnectionInfo)
uriAuthParameters :: URIAuth -> ConnectionInfo -> ConnectionInfo
uriAuthParameters URIAuth
uriAuth = ConnectionInfo -> ConnectionInfo
port (ConnectionInfo -> ConnectionInfo)
-> (ConnectionInfo -> ConnectionInfo)
-> ConnectionInfo
-> ConnectionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionInfo -> ConnectionInfo
host (ConnectionInfo -> ConnectionInfo)
-> (ConnectionInfo -> ConnectionInfo)
-> ConnectionInfo
-> ConnectionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionInfo -> ConnectionInfo
auth
  where
    port :: ConnectionInfo -> ConnectionInfo
port = case URIAuth -> String
uriPort URIAuth
uriAuth of
      (Char
':' : String
p) -> \ConnectionInfo
i -> ConnectionInfo
i {_port :: Word16
_port = String -> Word16
forall a. Read a => String -> a
read String
p}
      String
_ -> ConnectionInfo -> ConnectionInfo
forall a. a -> a
id
    host :: ConnectionInfo -> ConnectionInfo
host = case URIAuth -> String
uriRegName URIAuth
uriAuth of
      String
h -> \ConnectionInfo
i -> ConnectionInfo
i {_host :: ByteString
_host = String -> ByteString
pack String
h}
    auth :: ConnectionInfo -> ConnectionInfo
auth = case String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
":" (URIAuth -> String
uriUserInfo URIAuth
uriAuth) of
      [String
""] -> ConnectionInfo -> ConnectionInfo
forall a. a -> a
id
      [String
u] -> \ConnectionInfo
i -> ConnectionInfo
i {_username :: ByteString
_username = String -> ByteString
pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
dropLast String
u}
      [String
u, String
p] -> \ConnectionInfo
i -> ConnectionInfo
i {_username :: ByteString
_username = String -> ByteString
pack String
u, _password :: ByteString
_password = String -> ByteString
pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
dropLast String
p}
      [String]
_ -> ConnectionInfo -> ConnectionInfo
forall a. a -> a
id