never executed always true always false
1 module PureClaw.Security.Vault.Plugin
2 ( -- * Plugin type
3 AgePlugin (..)
4 -- * Plugin handle
5 , PluginHandle (..)
6 , mkPluginHandle
7 , mkMockPluginHandle
8 -- * Helpers
9 , pluginLabel
10 , pluginFromBinary
11 ) where
12
13 import Data.ByteString.Lazy qualified as BL
14 import Data.List qualified as L
15 import Data.Map.Strict qualified as Map
16 import Data.Text (Text)
17 import Data.Text qualified as T
18 import Data.Text.Encoding qualified as TE
19 import Data.Text.IO qualified as TIO
20 import System.Directory qualified as Dir
21 import System.FilePath qualified as FP
22 import System.Process.Typed
23
24 import PureClaw.Security.Vault.Age (AgeRecipient (..), VaultError (..))
25
26 -- | An age plugin discovered on PATH.
27 data AgePlugin = AgePlugin
28 { _ap_name :: !Text -- ^ Plugin name, e.g. "yubikey"
29 , _ap_binary :: !FilePath -- ^ Binary name, e.g. "age-plugin-yubikey"
30 , _ap_label :: !Text -- ^ Human-readable label, e.g. "YubiKey PIV"
31 } deriving stock (Show, Eq)
32
33 -- | Handle for age plugin detection and identity generation.
34 data PluginHandle = PluginHandle
35 { _ph_detect :: IO [AgePlugin]
36 , _ph_generate :: AgePlugin -> FilePath -> IO (Either VaultError (AgeRecipient, FilePath))
37 }
38
39 -- | Known age plugins with human-readable labels.
40 knownPluginLabels :: Map.Map Text Text
41 knownPluginLabels = Map.fromList
42 [ ("yubikey", "YubiKey PIV")
43 , ("tpm", "TPM 2.0")
44 , ("se", "Secure Enclave")
45 , ("fido2-hmac", "FIDO2 HMAC")
46 ]
47
48 -- | Look up a human-readable label for a plugin name.
49 -- Falls back to the plugin name itself if not in the known registry.
50 pluginLabel :: Text -> Text
51 pluginLabel name = Map.findWithDefault name name knownPluginLabels
52
53 -- | Construct an 'AgePlugin' from a binary name like @"age-plugin-yubikey"@.
54 -- Strips the @"age-plugin-"@ prefix and looks up the label.
55 pluginFromBinary :: FilePath -> AgePlugin
56 pluginFromBinary binary =
57 let name = T.pack (drop (length ("age-plugin-" :: String)) binary)
58 in AgePlugin
59 { _ap_name = name
60 , _ap_binary = binary
61 , _ap_label = pluginLabel name
62 }
63
64 -- | Construct a real 'PluginHandle' that scans PATH for age plugins.
65 mkPluginHandle :: PluginHandle
66 mkPluginHandle = PluginHandle
67 { _ph_detect = detectPlugins
68 , _ph_generate = generateIdentity
69 }
70
71 -- | Scan PATH for executables matching @age-plugin-*@.
72 detectPlugins :: IO [AgePlugin]
73 detectPlugins = do
74 pathVar <- FP.getSearchPath
75 binaries <- concat <$> mapM listAgePlugins pathVar
76 pure (map pluginFromBinary (L.nub binaries))
77
78 -- | List age-plugin-* executables in a single directory.
79 listAgePlugins :: FilePath -> IO [FilePath]
80 listAgePlugins dir = do
81 exists <- Dir.doesDirectoryExist dir
82 if not exists
83 then pure []
84 else do
85 entries <- Dir.listDirectory dir
86 let candidates = filter ("age-plugin-" `L.isPrefixOf`) entries
87 filterIO (\e -> do
88 let path = dir FP.</> e
89 isFile <- Dir.doesFileExist path
90 if isFile
91 then Dir.executable <$> Dir.getPermissions path
92 else pure False) candidates
93
94 -- | Filter a list with an IO predicate.
95 filterIO :: (a -> IO Bool) -> [a] -> IO [a]
96 filterIO _ [] = pure []
97 filterIO p (x:xs) = do
98 keep <- p x
99 rest <- filterIO p xs
100 pure (if keep then x : rest else rest)
101
102 -- | Run @age-plugin-\<name\> --generate@ and parse the output.
103 --
104 -- The plugin process inherits the terminal (stdin, stderr) so it can
105 -- prompt the user for PIN entry and touch confirmation. Only stdout
106 -- is captured — that's where the plugin writes the identity and
107 -- recipient.
108 generateIdentity :: AgePlugin -> FilePath -> IO (Either VaultError (AgeRecipient, FilePath))
109 generateIdentity plugin dir = do
110 let cfg = setStdin inherit
111 $ setStderr inherit
112 $ proc (_ap_binary plugin) ["--generate"]
113 (exitCode, out, _ignored) <- readProcess cfg
114 case exitCode of
115 ExitFailure code ->
116 pure (Left (AgeError ("plugin exited with code " <> T.pack (show code))))
117 ExitSuccess -> do
118 let outText = TE.decodeUtf8 (BL.toStrict out)
119 outputLines = T.lines outText
120 -- age-plugin-yubikey uses "# Recipient: age1..."
121 -- other plugins may use "# public key: age1..."
122 recipientLine = L.find (\l ->
123 let stripped = T.strip (T.dropWhile (== '#') (T.strip l))
124 in T.isPrefixOf "Recipient:" stripped
125 || T.isPrefixOf "public key:" stripped) outputLines
126 identityLines = filter (\l -> not (T.null l) && not (T.isPrefixOf "#" l)) outputLines
127 case recipientLine of
128 Nothing ->
129 pure (Left (AgeError "no recipient found in plugin output"))
130 Just rLine -> do
131 let afterHash = T.strip (T.dropWhile (== '#') (T.strip rLine))
132 recipient = T.strip (T.drop 1 (T.dropWhile (/= ':') afterHash))
133 identityPath = dir FP.</> T.unpack (_ap_name plugin) <> "-identity.txt"
134 TIO.writeFile identityPath (T.unlines identityLines)
135 pure (Right (AgeRecipient recipient, identityPath))
136
137 -- | Construct a mock 'PluginHandle' for testing.
138 mkMockPluginHandle
139 :: [AgePlugin]
140 -> (AgePlugin -> Either VaultError (AgeRecipient, FilePath))
141 -> PluginHandle
142 mkMockPluginHandle plugins genFn = PluginHandle
143 { _ph_detect = pure plugins
144 , _ph_generate = \p _dir -> pure (genFn p)
145 }