    {-# Language LambdaCase #-}
    -- Copyright (C) 2009-2012 John Millikin <john@john-millikin.com>
    --
    -- Licensed under the Apache License, Version 2.0 (the "License");
    -- you may not use this file except in compliance with the License.
    -- You may obtain a copy of the License at
    --
    --     http://www.apache.org/licenses/LICENSE-2.0
    --
    -- Unless required by applicable law or agreed to in writing, software
    -- distributed under the License is distributed on an "AS IS" BASIS,
    -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    -- See the License for the specific language governing permissions and
    -- limitations under the License.

    module DBus.Internal.Address where

    import           Data.Char (digitToInt, ord, chr)
    import           Data.Maybe (listToMaybe, fromMaybe)
    import           Data.List (intercalate)
    import qualified Data.Map
    import           Data.Map (Map)
    import           System.Environment (lookupEnv)
    import           Text.Printf (printf)

    import           Text.ParserCombinators.Parsec

    -- | When a D-Bus server must listen for connections, or a client must connect
    -- to a server, the listening socket's configuration is specified with an
    -- /address/. An address contains the /method/, which determines the
    -- protocol and transport mechanism, and /parameters/, which provide
    -- additional method-specific information about the address.
    data Address = Address String (Map String String)
        deriving (Address -> Address -> Bool
    (Address -> Address -> Bool)
    -> (Address -> Address -> Bool) -> Eq Address
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Address -> Address -> Bool
    == :: Address -> Address -> Bool
    $c/= :: Address -> Address -> Bool
    /= :: Address -> Address -> Bool
    Eq)

    addressMethod :: Address -> String
    addressMethod :: Address -> String
    addressMethod (Address String
    x Map String String
    _ ) = String
    x

    addressParameters :: Address -> Map String String
    addressParameters :: Address -> Map String String
    addressParameters (Address String
    _ Map String String
    x) = Map String String
    x

    -- | Try to convert a method string and parameter map to an 'Address'.
    --
    -- Returns 'Nothing' if the method or parameters are invalid.
    address :: String -> Map String String -> Maybe Address
    address :: String -> Map String String -> Maybe Address
    address String
    method Map String String
    params = if String -> Bool
    validMethod String
    method Bool -> Bool -> Bool
    && Map String String -> Bool
    validParams Map String String
    params
        then if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    method Bool -> Bool -> Bool
    && Map String String -> Bool
    forall k a. Map k a -> Bool
    Data.Map.null Map String String
    params
            then Maybe Address
    forall a. Maybe a
    Nothing
            else Address -> Maybe Address
    forall a. a -> Maybe a
    Just (String -> Map String String -> Address
    Address String
    method Map String String
    params)
        else Maybe Address
    forall a. Maybe a
    Nothing

    validMethod :: String -> Bool
    validMethod :: String -> Bool
    validMethod = (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    validChar where
        validChar :: Char -> Bool
    validChar Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ';' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':'

    validParams :: Map String String -> Bool
    validParams :: Map String String -> Bool
    validParams = ((String, String) -> Bool) -> [(String, String)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (String, String) -> Bool
    forall {a}. (String, [a]) -> Bool
    validItem ([(String, String)] -> Bool)
    -> (Map String String -> [(String, String)])
    -> Map String String
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    Data.Map.toList where
        validItem :: (String, [a]) -> Bool
    validItem (String
    k, [a]
    v) = String -> Bool
    forall a. [a] -> Bool
    notNull String
    k Bool -> Bool -> Bool
    && [a] -> Bool
    forall a. [a] -> Bool
    notNull [a]
    v Bool -> Bool -> Bool
    && String -> Bool
    validKey String
    k
        validKey :: String -> Bool
    validKey = (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    validChar
        validChar :: Char -> Bool
    validChar Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ';' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ',' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '='
        notNull :: [a] -> Bool
    notNull = Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null

    optionallyEncoded :: [Char]
    optionallyEncoded :: String
    optionallyEncoded = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        [ [Char
    '0'..Char
    '9']
        , [Char
    'a'..Char
    'z']
        , [Char
    'A'..Char
    'Z']
        , [Char
    '-', Char
    '_', Char
    '/', Char
    '\\', Char
    '*', Char
    '.']
        ]

    -- | Convert an address to a string in the format expected by 'parseAddress'.
    formatAddress :: Address -> String
    formatAddress :: Address -> String
    formatAddress (Address String
    method Map String String
    params) = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    method, String
    ":", String
    csvParams] where
        csvParams :: String
    csvParams = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ do
            (k, v) <- Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    Data.Map.toList Map String String
    params
            let v' = (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    escape String
    v
            return (concat [k, "=", v'])

        escape :: Char -> String
    escape Char
    c = if Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem Char
    c String
    optionallyEncoded
            then [Char
    c]
            else String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "%%%02X" (Char -> Int
    ord Char
    c)

    -- | Convert a list of addresses to a string in the format expected by
    -- 'parseAddresses'.
    formatAddresses :: [Address] -> String
    formatAddresses :: [Address] -> String
    formatAddresses = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ";" ([String] -> String)
    -> ([Address] -> [String]) -> [Address] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Address -> String) -> [Address] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Address -> String
    formatAddress

    instance Show Address where
        showsPrec :: Int -> Address -> String -> String
    showsPrec Int
    d Address
    x = Bool -> (String -> String) -> String -> String
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) ((String -> String) -> String -> String)
    -> (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
            String -> String -> String
    showString String
    "Address " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            String -> String -> String
    forall a. Show a => a -> String -> String
    shows (Address -> String
    formatAddress Address
    x)

    -- | Try to parse a string containing one valid address.
    --
    -- An address string is in the format @method:key1=val1,key2=val2@. There
    -- are some limitations on the characters allowed within methods and
    -- parameters; see the D-Bus specification for full details.
    parseAddress :: String -> Maybe Address
    parseAddress :: String -> Maybe Address
    parseAddress = Parser Address -> String -> Maybe Address
    forall a. Parser a -> String -> Maybe a
    maybeParseString (Parser Address -> String -> Maybe Address)
    -> Parser Address -> String -> Maybe Address
    forall a b. (a -> b) -> a -> b
    $ do
        addr <- Parser Address
    parsecAddress
        eof
        return addr

    -- | Try to parse a string containing one or more valid addresses.
    --
    -- Addresses are separated by semicolons. See 'parseAddress' for the format
    -- of addresses.
    parseAddresses :: String -> Maybe [Address]
    parseAddresses :: String -> Maybe [Address]
    parseAddresses = Parser [Address] -> String -> Maybe [Address]
    forall a. Parser a -> String -> Maybe a
    maybeParseString (Parser [Address] -> String -> Maybe [Address])
    -> Parser [Address] -> String -> Maybe [Address]
    forall a b. (a -> b) -> a -> b
    $ do
        addrs <- Parser Address
    -> ParsecT String () Identity Char -> Parser [Address]
    forall s (m :: * -> *) t u a sep.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
    sepEndBy Parser Address
    parsecAddress (Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ';')
        eof
        return addrs

    parsecAddress :: Parser Address
    parsecAddress :: Parser Address
    parsecAddress = Parser Address
    forall {u}. ParsecT String u Identity Address
    p where
        p :: ParsecT String u Identity Address
    p = do
            method <- ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many (String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    ":;")
            _ <- char ':'
            params <- sepEndBy param (char ',')
            return (Address method (Data.Map.fromList params))

        param :: ParsecT String u Identity (String, String)
    param = do
            key <- ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    "=;,")
            _ <- char '='
            value <- many1 valueChar
            return (key, value)

        valueChar :: ParsecT String u Identity Char
    valueChar = ParsecT String u Identity Char
    forall {u}. ParsecT String u Identity Char
    encoded ParsecT String u Identity Char
    -> ParsecT String u Identity Char -> ParsecT String u Identity Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ParsecT String u Identity Char
    forall {u}. ParsecT String u Identity Char
    unencoded
        encoded :: ParsecT String u Identity Char
    encoded = do
            _ <- Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '%'
            hex <- count 2 hexDigit
            return (chr (hexToInt hex))
        unencoded :: ParsecT String u Identity Char
    unencoded = String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    oneOf String
    optionallyEncoded

    -- | Returns the address in the environment variable
    -- @DBUS_SYSTEM_BUS_ADDRESS@, or
    -- @unix:path=\/var\/run\/dbus\/system_bus_socket@ if @DBUS_SYSTEM_BUS_ADDRESS@
    -- is not set.
    --
    -- Returns 'Nothing' if @DBUS_SYSTEM_BUS_ADDRESS@ contains an invalid address.
    getSystemAddress :: IO (Maybe Address)
    getSystemAddress :: IO (Maybe Address)
    getSystemAddress = do
        let system :: String
    system = String
    "unix:path=/var/run/dbus/system_bus_socket"
        env <- String -> IO (Maybe String)
    lookupEnv String
    "DBUS_SYSTEM_BUS_ADDRESS"
        return (parseAddress (fromMaybe system env))

    -- | Returns the first address in the environment variable
    -- @DBUS_SESSION_BUS_ADDRESS@, which must be set.
    --
    -- Returns 'Nothing' if @DBUS_SYSTEM_BUS_ADDRESS@ contains an invalid address
    -- or @DBUS_SESSION_BUS_ADDRESS@ is unset @XDG_RUNTIME_DIR@ doesn't have @/bus@.
    getSessionAddress :: IO (Maybe Address)
    getSessionAddress :: IO (Maybe Address)
    getSessionAddress = String -> IO (Maybe String)
    lookupEnv String
    "DBUS_SESSION_BUS_ADDRESS" IO (Maybe String)
    -> (Maybe String -> IO (Maybe Address)) -> IO (Maybe Address)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just String
    addrs -> Maybe Address -> IO (Maybe Address)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Maybe [Address]
    parseAddresses String
    addrs Maybe [Address] -> ([Address] -> Maybe Address) -> Maybe Address
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Address] -> Maybe Address
    forall a. [a] -> Maybe a
    listToMaybe)
        Maybe String
    Nothing -> (Maybe String -> (String -> Maybe Address) -> Maybe Address
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Maybe Address
    parseFallback) (Maybe String -> Maybe Address)
    -> IO (Maybe String) -> IO (Maybe Address)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    lookupEnv String
    "XDG_RUNTIME_DIR"
      where
        parseFallback :: String -> Maybe Address
    parseFallback String
    dir = String -> Maybe Address
    parseAddress (String
    "unix:path=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/bus")

    -- | Returns the address in the environment variable
    -- @DBUS_STARTER_ADDRESS@, which must be set.
    --
    -- Returns 'Nothing' if @DBUS_STARTER_ADDRESS@ is unset or contains an
    -- invalid address.
    getStarterAddress :: IO (Maybe Address)
    getStarterAddress :: IO (Maybe Address)
    getStarterAddress = do
        env <- String -> IO (Maybe String)
    lookupEnv String
    "DBUS_STARTER_ADDRESS"
        return (env >>= parseAddress)

    hexToInt :: String -> Int
    hexToInt :: String -> Int
    hexToInt = (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) (Int -> Int -> Int) -> (Int -> Int) -> Int -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int
    16 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *)) Int
    0 ([Int] -> Int) -> (String -> [Int]) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Int) -> String -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Int
    digitToInt

    maybeParseString :: Parser a -> String -> Maybe a
    maybeParseString :: forall a. Parser a -> String -> Maybe a
    maybeParseString Parser a
    p String
    str = case Parser a -> () -> String -> String -> Either ParseError a
    forall tok st a.
    GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
    runParser Parser a
    p () String
    "" String
    str of
        Left ParseError
    _ -> Maybe a
    forall a. Maybe a
    Nothing
        Right a
    a -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a