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