rofi-extras/app/pinentry-rofi.hs

--------------------------------------------------------------------------------
-- rofi-pinentry - a simply pinentry proxy for bitwarden
--
-- Rather than prompt the user like all the other pinentry programs, call the
-- bitwarden deamon and prompt for a password there

module Main where

import Bitwarden.Internal
import qualified Data.Text.IO as TI
import Data.Yaml
import RIO
import RIO.Directory
import qualified RIO.List as L
import qualified RIO.Text as T
import System.FilePath.Posix
import System.Posix.Process
import UnliftIO.Environment

main :: IO ()
main = runSimpleApp $ do
  hSetBuffering stdout LineBuffering
  logInfo "OK Pleased to meet you"
  pinentryLoop =<< readPinConf

newtype PinConf = PinConf {pcBwName :: T.Text} deriving (Eq, Show)

instance FromJSON PinConf where
  parseJSON (Object o) = PinConf <$> o .:? "bitwarden-name" .!= "gnupg"
  parseJSON _ = fail "pinentry yaml parse error"

readPinConf :: RIO SimpleApp PinConf
readPinConf = do
  c <- liftIO . decodeFileEither =<< pinConfDir
  case c of
    Left e -> do
      logError $ displayShow e
      exitWith (ExitFailure 1)
    Right r -> return r

pinConfDir :: RIO SimpleApp FilePath
pinConfDir = maybe defHome (return . (</> confname)) =<< lookupEnv "GNUPGHOME"
  where
    defHome = (</> ".gnupg" </> confname) <$> getHomeDirectory
    confname = "pinentry-rofi.yml"

pinentryLoop :: PinConf -> RIO SimpleApp ()
pinentryLoop p = do
  processLine p . T.words =<< liftIO TI.getLine
  pinentryLoop p

processLine :: PinConf -> [T.Text] -> RIO SimpleApp ()
processLine _ [] = noop
processLine _ ["BYE"] = exitSuccess
processLine p ["GETPIN"] = getPin p
processLine _ ["GETINFO", o] = processGetInfo o
-- TODO this might be important
processLine _ ["OPTION", o] = processOption o
-- these should all do nothing
processLine _ ("SETDESC" : _) = noop
processLine _ ("SETOK" : _) = noop
processLine _ ("SETNOTOK" : _) = noop
processLine _ ("SETCANCEL" : _) = noop
processLine _ ("SETPROMPT" : _) = noop
processLine _ ("SETERROR" : _) = noop
-- CONFIRM can take a flag
processLine _ ["CONFIRM"] = noop
processLine _ ["CONFIRM", "--one-button", _] = noop
processLine _ ss = unknownCommand $ T.unwords ss

unknownCommand :: T.Text -> RIO SimpleApp ()
unknownCommand c = putStrLnT $ T.append "ERR 275 Unknown command " c

getPin :: PinConf -> RIO SimpleApp ()
getPin p = do
  its <- getItems
  let w = (password . login) =<< L.find (\i -> pcBwName p == name i) its
  maybe err send w
  where
    err = putStrLnT "ERR 83886179 Operation canceled <rofi>"

-- these are the only supported options for GETINFO; anything else is an error
processGetInfo :: T.Text -> RIO SimpleApp ()
processGetInfo "pid" = send . T.pack . show =<< liftIO getProcessID
processGetInfo "version" = noop
processGetInfo "flavor" = noop
processGetInfo "ttyinfo" = noop
processGetInfo _ = putStrLnT "ERR 83886360 IPC parameter error <rofi>"

processOption :: T.Text -> RIO SimpleApp ()
processOption _ = noop

send :: T.Text -> RIO SimpleApp ()
send s = putStrLnT (T.append "D " s) >> ok

noop :: RIO SimpleApp ()
noop = ok

ok :: RIO SimpleApp ()
ok = putStrLnT "OK"

putStrLnT :: MonadIO m => T.Text -> m ()
putStrLnT = liftIO . TI.putStrLn