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
  (IO ByteString -> IO () -> IO ByteString)
-> IO () -> IO ByteString -> IO ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO ByteString -> IO () -> IO ByteString
forall a b. IO a -> IO b -> IO a
finally (Socket -> IO ()
close Socket
r) (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
    (IO ByteString -> IO () -> IO ByteString)
-> IO () -> IO ByteString -> IO ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO ByteString -> IO () -> IO ByteString
forall a b. IO a -> IO b -> IO a
finally (Socket -> IO ()
close Socket
w) (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
      Socket -> (ProtocolNumber -> IO ByteString) -> IO ByteString
forall r. Socket -> (ProtocolNumber -> IO r) -> IO r
withFdSocket Socket
w ((ProtocolNumber -> IO ByteString) -> IO ByteString)
-> (ProtocolNumber -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ProtocolNumber
fdInt -> do
        let fd :: Variant
fd = Fd -> Variant
forall a. IsVariant a => a -> Variant
toVariant (ProtocolNumber -> Fd
Fd ProtocolNumber
fdInt)
        Request (Map Text Variant)
req <- Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO (Map Text Variant))
-> IO (Request (Map Text Variant))
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] Map Text Variant
forall a. Monoid a => a
mempty Map Text Variant -> IO (Map Text Variant)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        Request (Map Text Variant) -> IO (Maybe (Map Text Variant))
forall a. Request a -> IO (Maybe a)
await Request (Map Text Variant)
req IO (Maybe (Map Text Variant))
-> (Maybe (Map Text Variant) -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (Map Text Variant)
Nothing ->
            ClientError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO ByteString)
-> (String -> ClientError) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO ByteString) -> String -> IO ByteString
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