    {-# 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.Connection (ConnectInfo(..), defaultConnectInfo)
    import qualified Database.Redis.ConnectionContext as CC
    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 String
    url = do
        URI
    uri <- String -> Maybe URI -> Either String URI
    forall a b. a -> Maybe b -> Either a b
    note String
    "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 String
    "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
    == String
    "redis:"
        URIAuthority
    uriAuth <- String -> Maybe URIAuthority -> Either String URIAuthority
    forall a b. a -> Maybe b -> Either a b
    note String
    "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
    == Char
    '/') (URI -> String
    uriPath URI
    uri)

        Integer
    db <- if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    dbNumPart
          then Integer -> Either String Integer
    forall a. a -> Either String a
    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 (String
    "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 a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ConnectInfo
    defaultConnectInfo
            { connectHost = if null h
                then connectHost defaultConnectInfo
                else h
            , connectPort = maybe (connectPort defaultConnectInfo) (CC.PortNumber . fromIntegral) (port uriAuth)
            , connectAuth = C8.pack <$> password uriAuth
            , connectDatabase = db
            }