module Desktop.Portal.Account
  ( -- * Get User Information
    GetUserInformationOptions (..),
    GetUserInformationResults (..),
    getUserInformation,
  )
where

import Control.Exception (throwIO)
import DBus (InterfaceName)
import DBus qualified
import DBus.Client qualified as DBus
import Data.Default.Class (Default (def))
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import Desktop.Portal.Internal (Client, Request, sendRequest)
import Desktop.Portal.Util (decodeFileUri, mapJust, optionalFromVariant, toVariantPair)

data GetUserInformationOptions = GetUserInformationOptions
  { GetUserInformationOptions -> Maybe Text
window :: Maybe Text,
    GetUserInformationOptions -> Maybe Text
reason :: Maybe Text
  }
  deriving (GetUserInformationOptions -> GetUserInformationOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserInformationOptions -> GetUserInformationOptions -> Bool
$c/= :: GetUserInformationOptions -> GetUserInformationOptions -> Bool
== :: GetUserInformationOptions -> GetUserInformationOptions -> Bool
$c== :: GetUserInformationOptions -> GetUserInformationOptions -> Bool
Eq, Int -> GetUserInformationOptions -> ShowS
[GetUserInformationOptions] -> ShowS
GetUserInformationOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserInformationOptions] -> ShowS
$cshowList :: [GetUserInformationOptions] -> ShowS
show :: GetUserInformationOptions -> String
$cshow :: GetUserInformationOptions -> String
showsPrec :: Int -> GetUserInformationOptions -> ShowS
$cshowsPrec :: Int -> GetUserInformationOptions -> ShowS
Show)

instance Default GetUserInformationOptions where
  def :: GetUserInformationOptions
def =
    GetUserInformationOptions
      { $sel:window:GetUserInformationOptions :: Maybe Text
window = forall a. Maybe a
Nothing,
        $sel:reason:GetUserInformationOptions :: Maybe Text
reason = forall a. Maybe a
Nothing
      }

data GetUserInformationResults = GetUserInformationResults
  { GetUserInformationResults -> Text
id :: Text,
    GetUserInformationResults -> Text
name :: Text,
    GetUserInformationResults -> Maybe String
image :: Maybe FilePath
  }
  deriving (GetUserInformationResults -> GetUserInformationResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserInformationResults -> GetUserInformationResults -> Bool
$c/= :: GetUserInformationResults -> GetUserInformationResults -> Bool
== :: GetUserInformationResults -> GetUserInformationResults -> Bool
$c== :: GetUserInformationResults -> GetUserInformationResults -> Bool
Eq, Int -> GetUserInformationResults -> ShowS
[GetUserInformationResults] -> ShowS
GetUserInformationResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserInformationResults] -> ShowS
$cshowList :: [GetUserInformationResults] -> ShowS
show :: GetUserInformationResults -> String
$cshow :: GetUserInformationResults -> String
showsPrec :: Int -> GetUserInformationResults -> ShowS
$cshowsPrec :: Int -> GetUserInformationResults -> ShowS
Show)

accountInterface :: InterfaceName
accountInterface :: InterfaceName
accountInterface = InterfaceName
"org.freedesktop.portal.Account"

getUserInformation :: Client -> GetUserInformationOptions -> IO (Request GetUserInformationResults)
getUserInformation :: Client
-> GetUserInformationOptions
-> IO (Request GetUserInformationResults)
getUserInformation Client
client GetUserInformationOptions
options =
  forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
accountInterface MemberName
"GetUserInformation" [Variant
window] Map Text Variant
optionsArg Map Text Variant -> IO GetUserInformationResults
parseResponse
  where
    window :: Variant
window = forall a. IsVariant a => a -> Variant
DBus.toVariant (forall a. a -> Maybe a -> a
fromMaybe Text
"" GetUserInformationOptions
options.window)
    optionsArg :: Map Text Variant
optionsArg =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"reason" GetUserInformationOptions
options.reason
        ]

    parseResponse :: Map Text Variant -> IO GetUserInformationResults
parseResponse = \case
      Map Text Variant
resMap
        | Just Text
id' <- forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"id" Map Text Variant
resMap,
          Just Text
name <- forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"name" Map Text Variant
resMap,
          Just Maybe String
image <- forall a b. (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
mapJust Text -> Maybe String
decodeFileUri forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
IsVariant a =>
Text -> Map Text Variant -> Maybe (Maybe a)
optionalFromVariant Text
"image" Map Text Variant
resMap -> do
            forall (f :: * -> *) a. Applicative f => a -> f a
pure GetUserInformationResults {$sel:id:GetUserInformationResults :: Text
id = Text
id', Text
name :: Text
$sel:name:GetUserInformationResults :: Text
name, Maybe String
image :: Maybe String
$sel:image:GetUserInformationResults :: Maybe String
image}
      Map Text Variant
resMap ->
        forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"getUserInformation: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Map Text Variant
resMap