    {-# LANGUAGE CPP #-}
    module Database.Redis.URL
        ( parseConnectInfo
        ) where

    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative ((<$>))
    #endif
    import Control.Error.Util (note)
    import Control.Monad (guard)
    #if __GLASGOW_HASKELL__ < 808
    import Data.Monoid ((<>))
    #endif
    import Database.Redis.Core (ConnectInfo(..), defaultConnectInfo)
    import Database.Redis.ProtocolPipelining
    import Network.HTTP.Base
    import Network.URI (parseURI, uriPath, uriScheme)
    import Text.Read (readMaybe)

    import qualified Data.ByteString.Char8 as C8

    -- | Parse a @'ConnectInfo'@ from a URL
    --
    -- Username is ignored, path is used to specify the database:
    --
    -- >>> parseConnectInfo "redis://username:password@host:42/2"
    -- Right (ConnInfo {connectHost = "host", connectPort = PortNumber 42, connectAuth = Just "password", connectDatabase = 2, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing, connectTLSParams = Nothing})
    --
    -- >>> parseConnectInfo "redis://username:password@host:42/db"
    -- Left "Invalid port: db"
    --
    -- The scheme is validated, to prevent mixing up configurations:
    --
    -- >>> parseConnectInfo "postgres://"
    -- Left "Wrong scheme"
    --
    -- Beyond that, all values are optional. Omitted values are taken from
    -- @'defaultConnectInfo'@:
    --
    -- >>> parseConnectInfo "redis://"
    -- Right (ConnInfo {connectHost = "localhost", connectPort = PortNumber 6379, connectAuth = Nothing, connectDatabase = 0, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing, connectTLSParams = Nothing})
    --
    parseConnectInfo :: String -> Either String ConnectInfo
    parseConnectInfo :: String -> Either String ConnectInfo
    parseConnectInfo url :: String
    url = do
        URI
    uri <- String -> Maybe URI -> Either String URI
    forall a b. a -> Maybe b -> Either a b
    note "Invalid URI" (Maybe URI -> Either String URI) -> Maybe URI -> Either String URI
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe URI
    parseURI String
    url
        String -> Maybe () -> Either String ()
    forall a b. a -> Maybe b -> Either a b
    note "Wrong scheme" (Maybe () -> Either String ()) -> Maybe () -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ URI -> String
    uriScheme URI
    uri String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "redis:"
        URIAuthority
    uriAuth <- String -> Maybe URIAuthority -> Either String URIAuthority
    forall a b. a -> Maybe b -> Either a b
    note "Missing or invalid Authority"
            (Maybe URIAuthority -> Either String URIAuthority)
    -> Maybe URIAuthority -> Either String URIAuthority
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe URIAuthority
    parseURIAuthority
            (String -> Maybe URIAuthority) -> String -> Maybe URIAuthority
    forall a b. (a -> b) -> a -> b
    $ URI -> String
    uriToAuthorityString URI
    uri

        let h :: String
    h = URIAuthority -> String
    host URIAuthority
    uriAuth
            dbNumPart :: String
    dbNumPart = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '/') (URI -> String
    uriPath URI
    uri)

        Integer
    db <- if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    dbNumPart
          then Integer -> Either String Integer
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Either String Integer)
    -> Integer -> Either String Integer
    forall a b. (a -> b) -> a -> b
    $ ConnectInfo -> Integer
    connectDatabase ConnectInfo
    defaultConnectInfo
          else String -> Maybe Integer -> Either String Integer
    forall a b. a -> Maybe b -> Either a b
    note ("Invalid port: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    dbNumPart) (Maybe Integer -> Either String Integer)
    -> Maybe Integer -> Either String Integer
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe Integer
    forall a. Read a => String -> Maybe a
    readMaybe String
    dbNumPart

        ConnectInfo -> Either String ConnectInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return ConnectInfo
    defaultConnectInfo
            { connectHost :: String
    connectHost = if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    h
                then ConnectInfo -> String
    connectHost ConnectInfo
    defaultConnectInfo
                else String
    h
            , connectPort :: PortID
    connectPort = PortID -> (Int -> PortID) -> Maybe Int -> PortID
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (ConnectInfo -> PortID
    connectPort ConnectInfo
    defaultConnectInfo) (PortNumber -> PortID
    PortNumber (PortNumber -> PortID) -> (Int -> PortNumber) -> Int -> PortID
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) (URIAuthority -> Maybe Int
    port URIAuthority
    uriAuth)
            , connectAuth :: Maybe ByteString
    connectAuth = String -> ByteString
    C8.pack (String -> ByteString) -> Maybe String -> Maybe ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> URIAuthority -> Maybe String
    password URIAuthority
    uriAuth
            , connectDatabase :: Integer
    connectDatabase = Integer
    db
            }