module Desktop.Portal.Secret (retrieveSecret) where

import Control.Exception (finally, throwIO)
import DBus (InterfaceName, IsVariant (toVariant))
import DBus.Client qualified as DBus
import Data.ByteString (ByteString)
import Desktop.Portal.Internal (Client, await, sendRequest)
import Network.Socket (Family (..), SocketType (..), close, defaultProtocol, socketPair, withFdSocket)
import Network.Socket.ByteString (recv)
import System.Posix (Fd (..))

secretsInterface :: InterfaceName
secretsInterface :: InterfaceName
secretsInterface = InterfaceName
"org.freedesktop.portal.Secret"

-- | Retrieve the application-specific secret.
--
-- Currently works in Gnome, but not KDE (see https://bugs.kde.org/show_bug.cgi?id=466197 ).
-- The token parameter that is documented in the portal API specs is not supported either, as
-- it is not clear exactly how this should work and it does not seem to be supported by Gnome.
retrieveSecret :: Client -> IO ByteString
retrieveSecret :: Client -> IO ByteString
retrieveSecret Client
client = do
  (Socket
r, Socket
w) <- Family -> SocketType -> ProtocolNumber -> IO (Socket, Socket)
socketPair Family
AF_UNIX SocketType
Stream ProtocolNumber
defaultProtocol
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
finally (Socket -> IO ()
close Socket
r) forall a b. (a -> b) -> a -> b
$ do
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
finally (Socket -> IO ()
close Socket
w) forall a b. (a -> b) -> a -> b
$ do
      forall r. Socket -> (ProtocolNumber -> IO r) -> IO r
withFdSocket Socket
w forall a b. (a -> b) -> a -> b
$ \ProtocolNumber
fdInt -> do
        let fd :: Variant
fd = forall a. IsVariant a => a -> Variant
toVariant (ProtocolNumber -> Fd
Fd ProtocolNumber
fdInt)
        Request (Map Text Variant)
req <- forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
secretsInterface MemberName
"RetrieveSecret" [Variant
fd] forall a. Monoid a => a
mempty forall (f :: * -> *) a. Applicative f => a -> f a
pure
        forall a. Request a -> IO (Maybe a)
await Request (Map Text Variant)
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (Map Text Variant)
Nothing ->
            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
"retrieveSecret: request was cancelled."
          Just Map Text Variant
_tokens -> do
            Socket -> Int -> IO ByteString
recv Socket
r Int
4096