diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-12-27 16:01:43 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-12-27 16:01:43 -0400 |
| commit | c1cc4d23de10e5669a42164b9145acea732be60d (patch) | |
| tree | da75e73f9a0523428233d0e5f644826bae07c379 /Remote/External | |
| parent | c1d48d64b4d93c0a684ef68262b9e14b1b63005d (diff) | |
add credential storage support for external special remotes & update example
Diffstat (limited to 'Remote/External')
| -rw-r--r-- | Remote/External/Types.hs | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index a4d49ddf1..fbd050fe1 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -44,6 +44,7 @@ import Control.Concurrent.STM -- The data External = External { externalType :: ExternalType + , externalUUID :: UUID -- Empty until the remote is running. , externalState :: TMVar ExternalState -- Empty when a remote is in use. @@ -52,9 +53,10 @@ data External = External , externalConfig :: TMVar RemoteConfig } -newExternal :: ExternalType -> RemoteConfig -> Annex External -newExternal externaltype c = liftIO $ External +newExternal :: ExternalType -> UUID -> RemoteConfig -> Annex External +newExternal externaltype u c = liftIO $ External <$> pure externaltype + <*> pure u <*> atomically newEmptyTMVar <*> atomically (newTMVar ExternalLock) <*> atomically (newTMVar c) @@ -157,6 +159,8 @@ data RemoteRequest | DIRHASH Key | SETCONFIG Setting String | GETCONFIG Setting + | SETCREDS Setting String String + | GETCREDS Setting deriving (Show) instance Receivable RemoteRequest where @@ -165,15 +169,19 @@ instance Receivable RemoteRequest where parseCommand "DIRHASH" = parse1 DIRHASH parseCommand "SETCONFIG" = parse2 SETCONFIG parseCommand "GETCONFIG" = parse1 GETCONFIG + parseCommand "SETCREDS" = parse3 SETCREDS + parseCommand "GETCREDS" = parse1 GETCREDS parseCommand _ = parseFail -- Responses to RemoteRequest. data RemoteResponse = VALUE String + | CREDS String String deriving (Show) instance Sendable RemoteResponse where formatMessage (VALUE s) = [ "VALUE", serialize s ] + formatMessage (CREDS login password) = [ "CREDS", serialize login, serialize password ] -- Messages that can be sent at any time by either git-annex or the remote. data AsyncMessage |