1{- git credential interface
2 -
3 - Copyright 2019-2020 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Git.Credential where
9
10import Common
11import Git
12import Git.Command
13import Utility.Url
14
15import qualified Data.Map as M
16
17data Credential = Credential { fromCredential :: M.Map String String }
18
19credentialUsername :: Credential -> Maybe String
20credentialUsername = M.lookup "username" . fromCredential
21
22credentialPassword :: Credential -> Maybe String
23credentialPassword = M.lookup "password" . fromCredential
24
25credentialBasicAuth :: Credential -> Maybe BasicAuth
26credentialBasicAuth cred = BasicAuth
27	<$> credentialUsername cred
28	<*> credentialPassword cred
29
30getBasicAuthFromCredential :: Repo -> GetBasicAuth
31getBasicAuthFromCredential r u = do
32	c <- getUrlCredential u r
33	case credentialBasicAuth c of
34		Just ba -> return $ Just (ba, signalsuccess c)
35		Nothing -> do
36			signalsuccess c False
37			return Nothing
38  where
39	signalsuccess c True = approveUrlCredential c r
40	signalsuccess c False = rejectUrlCredential c r
41
42-- | This may prompt the user for login information, or get cached login
43-- information.
44getUrlCredential :: URLString -> Repo -> IO Credential
45getUrlCredential = runCredential "fill" . urlCredential
46
47-- | Call if the credential the user entered works, and can be cached for
48-- later use if git is configured to do so.
49approveUrlCredential :: Credential -> Repo -> IO ()
50approveUrlCredential c = void . runCredential "approve" c
51
52-- | Call if the credential the user entered does not work.
53rejectUrlCredential :: Credential -> Repo -> IO ()
54rejectUrlCredential c = void . runCredential "reject" c
55
56urlCredential :: URLString -> Credential
57urlCredential = Credential . M.singleton "url"
58
59runCredential :: String -> Credential -> Repo -> IO Credential
60runCredential action input r =
61	parseCredential . decodeBS <$> pipeWriteRead
62		[ Param "credential"
63		, Param action
64		]
65		(Just (flip hPutStr formatinput))
66		r
67  where
68	formatinput = concat
69		[ formatCredential input
70		, "\n" -- blank line signifies end of input
71		]
72
73formatCredential :: Credential -> String
74formatCredential = unlines . map (\(k, v) -> k ++"=" ++ v) . M.toList . fromCredential
75
76parseCredential :: String -> Credential
77parseCredential = Credential . M.fromList . map go . lines
78  where
79	go l = case break (== '=') l of
80		(k, _:v) -> (k, v)
81		(k, []) -> (k, "")
82