diff --git a/vault-tool-server/test/test.hs b/vault-tool-server/test/test.hs index fa05f4d..c3cfbe1 100644 --- a/vault-tool-server/test/test.hs +++ b/vault-tool-server/test/test.hs @@ -163,6 +163,22 @@ talkToVault addr = do , VaultSecretPath "secret/foo/quack/duck" ] + vaultAuthEnable conn "approle" + + vaultWrite conn (VaultSecretPath "secret/small") (object ["X" .= 'x']) + + vaultPolicyCreate conn "foo" "path \"secret/small\" { capabilities = [\"read\"] }" + vaultAppRoleCreate conn "foo-role" defaultVaultAppRoleParameters{_VaultAppRoleParameters_Policies=["foo"]} + + roleId <- vaultAppRoleRoleIdRead conn "foo-role" + secretId <- _VaultAppRoleSecretIdGenerateResponse_SecretId <$> vaultAppRoleSecretIdGenerate conn "foo-role" "" + + arConn <- connectToVaultAppRole addr roleId secretId + (_, ar1) <- vaultRead conn (VaultSecretPath "secret/small") + case ar1 of + Left (v, _) -> v @?= object ["X" .= 'x'] + Right (x :: FunStuff) -> assertFailure $ "Somehow parsed an impossible value" ++ show x + vaultSeal conn status5 <- vaultSealStatus addr diff --git a/vault-tool/src/Network/VaultTool.hs b/vault-tool/src/Network/VaultTool.hs index 398e1b1..56cf839 100644 --- a/vault-tool/src/Network/VaultTool.hs +++ b/vault-tool/src/Network/VaultTool.hs @@ -21,6 +21,10 @@ module Network.VaultTool , connectToVaultAppRole + , vaultAuthEnable + + , vaultPolicyCreate + , vaultInit , VaultSealStatus(..) , vaultSealStatus @@ -28,6 +32,13 @@ module Network.VaultTool , VaultUnseal(..) , vaultUnseal + , vaultAppRoleCreate + , vaultAppRoleRoleIdRead + , vaultAppRoleSecretIdGenerate + , defaultVaultAppRoleParameters + , VaultAppRoleParameters(..) + , VaultAppRoleSecretIdGenerateResponse(..) + , VaultMount(..) , VaultMountRead , VaultMountWrite @@ -50,17 +61,18 @@ module Network.VaultTool , vaultListRecursive ) where +import Data.Monoid ((<>)) import Control.Exception (throwIO) import Control.Monad (liftM) import Data.Aeson -import Data.Aeson.Types (parseEither) +import Data.Aeson.Types (parseEither, Pair) import Data.List (sortOn) import Data.Text (Text) +import Data.Maybe (catMaybes) import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified Data.HashMap.Strict as H import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import Network.VaultTool.Internal import Network.VaultTool.Types @@ -207,31 +219,156 @@ instance FromJSON VaultAuth where -- | -- -- See 'sample-response-7' -data VaultAppRoleAuthResponse = VaultAppRoleAuthResponse - { _VaultAppRoleAuthResponse_Auth :: VaultAuth - , _VaultAppRoleAuthResponse_LeaseDuration :: Int - , _VaultAppRoleAuthResponse_Renewable :: Bool +data VaultAppRoleResponse = VaultAppRoleResponse + { _VaultAppRoleResponse_Auth :: Maybe VaultAuth + , _VaultAppRoleResponse_Warnings :: Value + , _VaultAppRoleResponse_WrapInfo :: Value + , _VaultAppRoleResponse_Data :: Value + , _VaultAppRoleResponse_LeaseDuration :: Int + , _VaultAppRoleResponse_Renewable :: Bool + , _VaultAppRoleResponse_LeaseId :: Text } - deriving (Show, Eq, Ord) + deriving (Show, Eq) -instance FromJSON VaultAppRoleAuthResponse where +instance FromJSON VaultAppRoleResponse where parseJSON (Object v) = - VaultAppRoleAuthResponse <$> - v .: "auth" <*> + VaultAppRoleResponse <$> + v .:? "auth" <*> + v .: "warnings" <*> + v .: "wrap_info" <*> + v .: "data" <*> v .: "lease_duration" <*> - v .: "renewable" + v .: "renewable" <*> + v .: "lease_id" parseJSON _ = fail "Not an Object" -- | vaultAppRoleLogin :: VaultAddress -> Manager -> VaultAppRoleId -> VaultAppRoleSecretId -> IO VaultAuthToken vaultAppRoleLogin addr manager roleId secretId = do response <- vaultRequestJSON manager "POST" (vaultUrl addr "/auth/approle/login") [] (Just reqBody) [200] - return . _VaultAuth_ClientToken $ _VaultAppRoleAuthResponse_Auth response + maybe failOnNullAuth (return . _VaultAuth_ClientToken) $ _VaultAppRoleResponse_Auth response + where + reqBody = object + [ "role_id" .= unVaultAppRoleId roleId, + "secret_id" .= unVaultAppRoleSecretId secretId + ] + failOnNullAuth = fail "Auth on login is null" + +-- | +vaultAuthEnable :: VaultConnection -> Text -> IO () +vaultAuthEnable VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} authMethod = do + _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/sys/auth/" ++ T.unpack authMethod) headers (Just reqBody) [204] + pure () where - reqBody = object - [ "role_id" .= TE.decodeUtf8 (unVaultAppRoleId roleId), - "secret_id" .= TE.decodeUtf8 (unVaultAppRoleSecretId secretId) + reqBody = object [ "type" .= authMethod ] + headers = [("X-Vault-Token", unVaultAuthToken _VaultConnection_AuthToken)] + +-- | +vaultPolicyCreate :: VaultConnection -> Text -> Text -> IO () +vaultPolicyCreate VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} policyName policy = do + _ <- vaultRequest _VaultConnection_Manager "PUT" (vaultUrl _VaultConnection_VaultAddress "/sys/policies/acl/" ++ T.unpack policyName) headers (Just reqBody) [204] + pure () + where + reqBody = object [ "policy" .= policy ] + headers = [("X-Vault-Token", unVaultAuthToken _VaultConnection_AuthToken)] + +data VaultAppRoleListResponse = VaultAppRoleListResponse + { _VaultAppRoleListResponse_AppRoles :: [Text] } + +instance FromJSON VaultAppRoleListResponse where + parseJSON (Object v) = + VaultAppRoleListResponse <$> + v .: "keys" + parseJSON _ = fail "Not an Object" + +-- | +-- +-- Note: For TTL fields, only integer number seconds, i.e. 3600, are supported +data VaultAppRoleParameters = VaultAppRoleParameters + { _VaultAppRoleParameters_BindSecretId :: Bool + , _VaultAppRoleParameters_Policies :: [Text] + , _VaultAppRoleParameters_SecretIdNumUses :: Maybe Int + , _VaultAppRoleParameters_SecretIdTTL :: Maybe Int + , _VaultAppRoleParameters_TokenNumUses :: Maybe Int + , _VaultAppRoleParameters_TokenTTL :: Maybe Int + , _VaultAppRoleParameters_TokenMaxTTL :: Maybe Int + , _VaultAppRoleParameters_Period :: Maybe Int + } + +instance ToJSON VaultAppRoleParameters where + toJSON v = object $ + [ "bind_secret_id" .= _VaultAppRoleParameters_BindSecretId v + , "policies" .= _VaultAppRoleParameters_Policies v + ] <> catMaybes + [ "secret_id_num_uses" .=? _VaultAppRoleParameters_SecretIdNumUses v + , "secret_id_ttl" .=? _VaultAppRoleParameters_SecretIdTTL v + , "token_num_uses" .=? _VaultAppRoleParameters_TokenNumUses v + , "token_ttl" .=? _VaultAppRoleParameters_TokenTTL v + , "token_max_ttl" .=? _VaultAppRoleParameters_TokenMaxTTL v + , "period" .=? _VaultAppRoleParameters_Period v ] + where + (.=?) :: ToJSON x => Text -> Maybe x -> Maybe Pair + t .=? x = (t .=) <$> x + +instance FromJSON VaultAppRoleParameters where + parseJSON (Object v) = + VaultAppRoleParameters <$> + v .: "bind_secret_id" <*> + v .: "policies" <*> + v .:? "secret_id_num_uses" <*> + v .:? "secret_id_ttl" <*> + v .:? "token_num_uses" <*> + v .:? "token_ttl" <*> + v .:? "token_max_ttl" <*> + v .:? "period" + parseJSON _ = fail "Not an Object" + +defaultVaultAppRoleParameters :: VaultAppRoleParameters +defaultVaultAppRoleParameters = VaultAppRoleParameters True [] Nothing Nothing Nothing Nothing Nothing Nothing + +-- | +vaultAppRoleCreate :: VaultConnection -> Text -> VaultAppRoleParameters -> IO () +vaultAppRoleCreate VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} appRoleName varp = do + _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/auth/approle/role/" ++ T.unpack appRoleName) headers (Just varp) [204] + pure () + where + headers = [("X-Vault-Token", unVaultAuthToken _VaultConnection_AuthToken)] + +-- | +vaultAppRoleRoleIdRead :: VaultConnection -> Text -> IO VaultAppRoleId +vaultAppRoleRoleIdRead VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} appRoleName = do + response <- vaultRequestJSON _VaultConnection_Manager "GET" (vaultUrl _VaultConnection_VaultAddress "/auth/approle/role/" ++ T.unpack appRoleName ++ "/role-id") headers (Nothing :: Maybe ()) [200] + let d = _VaultAppRoleResponse_Data response + case parseEither parseJSON d of + Left err -> throwIO $ VaultException_ParseBodyError "GET" ("/auth/approle/role/" ++ T.unpack appRoleName ++ "/role-id") (encode d) err + Right obj -> return obj + where + headers = [("X-Vault-Token", unVaultAuthToken _VaultConnection_AuthToken)] + +data VaultAppRoleSecretIdGenerateResponse = VaultAppRoleSecretIdGenerateResponse + { _VaultAppRoleSecretIdGenerateResponse_SecretIdAccessor :: VaultAppRoleSecretIdAccessor + , _VaultAppRoleSecretIdGenerateResponse_SecretId :: VaultAppRoleSecretId + } + +instance FromJSON VaultAppRoleSecretIdGenerateResponse where + parseJSON (Object v) = + VaultAppRoleSecretIdGenerateResponse <$> + v .: "secret_id_accessor" <*> + v .: "secret_id" + parseJSON _ = fail "Not an Object" + +-- | +vaultAppRoleSecretIdGenerate :: VaultConnection -> Text -> Text -> IO VaultAppRoleSecretIdGenerateResponse +vaultAppRoleSecretIdGenerate VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} appRoleName metadata = do + response <- vaultRequestJSON _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/auth/approle/role/" ++ T.unpack appRoleName ++ "/secret-id") headers (Just reqBody) [200] + let d = _VaultAppRoleResponse_Data response + case parseEither parseJSON d of + Left err -> throwIO $ VaultException_ParseBodyError "POST" ("/auth/approle/role/" ++ T.unpack appRoleName ++ "/secret-id") (encode d) err + Right obj -> return obj + where + reqBody = object[ "metadata" .= metadata ] + headers = [("X-Vault-Token", unVaultAuthToken _VaultConnection_AuthToken)] vaultSeal :: VaultConnection -> IO () vaultSeal VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} = do