diff --git a/src/Network/VaultTool.hs b/src/Network/VaultTool.hs --- a/src/Network/VaultTool.hs +++ b/src/Network/VaultTool.hs @@ -51,6 +51,8 @@ , vaultNewMount , vaultUnmount + , VaultMountedPath(..) + , VaultSearchPath(..) , VaultSecretPath(..) , VaultSecretMetadata(..) , vaultWrite @@ -79,6 +81,32 @@ import Network.VaultTool.Internal import Network.VaultTool.Types +data VaultAction + = Create + | ReadVersion + | ReadMetadata + | Update + | UpdateMetadata + | ListSecrets + | DeleteLast + | DeleteVersions + | Undelete + | Destroy + | DeleteMetadata + +vaultUrlPrefix :: VaultAction -> String +vaultUrlPrefix Create = "/data" +vaultUrlPrefix ReadVersion = "/data" +vaultUrlPrefix Update = "/data" +vaultUrlPrefix DeleteLast = "/data" +vaultUrlPrefix DeleteVersions = "/delete" +vaultUrlPrefix Undelete = "/undelete" +vaultUrlPrefix Destroy = "/destroy" +vaultUrlPrefix ListSecrets = "/metadata" +vaultUrlPrefix ReadMetadata = "/metadata" +vaultUrlPrefix UpdateMetadata = "/metadata" +vaultUrlPrefix DeleteMetadata = "/metadata" + data VaultConnection = VaultConnection { _VaultConnection_AuthToken :: VaultAuthToken , _VaultConnection_VaultAddress :: VaultAddress @@ -110,6 +138,10 @@ vaultUrl :: VaultAddress -> String -> String vaultUrl (VaultAddress addr) path = T.unpack addr ++ "/v1" ++ path +vaultActionUrl :: VaultAction -> VaultAddress -> VaultMountedPath -> VaultSearchPath -> String +vaultActionUrl action (VaultAddress addr) (VaultMountedPath mountedPath) (VaultSearchPath searchPath) = + T.unpack addr ++ "/v1/" ++ T.unpack mountedPath ++ (vaultUrlPrefix action) ++ "/" ++ T.unpack searchPath + -- | https://www.vaultproject.io/docs/http/sys-health.html vaultHealth :: VaultAddress -> IO VaultHealth vaultHealth vaultAddress = do @@ -262,7 +294,7 @@ -- | 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] + _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/sys/auth/" ++ T.unpack authMethod) headers (Just reqBody) [200] pure () where reqBody = object [ "type" .= authMethod ] @@ -271,7 +303,7 @@ -- | 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] + _ <- vaultRequest _VaultConnection_Manager "PUT" (vaultUrl _VaultConnection_VaultAddress "/sys/policies/acl/" ++ T.unpack policyName) headers (Just reqBody) [200] pure () where reqBody = object [ "policy" .= policy ] @@ -335,7 +367,7 @@ -- | 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] + _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/auth/approle/role/" ++ T.unpack appRoleName) headers (Just varp) [200] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -377,7 +409,7 @@ vaultSeal :: VaultConnection -> IO () vaultSeal VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} = do - _ <- vaultRequest _VaultConnection_Manager "PUT" (vaultUrl _VaultConnection_VaultAddress "/sys/seal") headers (Nothing :: Maybe ()) [204] + _ <- vaultRequest _VaultConnection_Manager "PUT" (vaultUrl _VaultConnection_VaultAddress "/sys/seal") headers (Nothing :: Maybe ()) [200] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -487,7 +519,7 @@ vaultMountSetTune :: VaultConnection -> Text -> VaultMountConfigWrite -> IO () vaultMountSetTune VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} mountPoint mountConfig = do let reqBody = mountConfig - _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/sys/mounts/" ++ T.unpack mountPoint ++ "/tune") headers (Just reqBody) [204] + _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/sys/mounts/" ++ T.unpack mountPoint ++ "/tune") headers (Just reqBody) [200] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -496,7 +528,7 @@ vaultNewMount :: VaultConnection -> Text -> VaultMountWrite -> IO () vaultNewMount VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} mountPoint vaultMount = do let reqBody = vaultMount - _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/sys/mounts/" ++ T.unpack mountPoint) headers (Just reqBody) [204] + _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/sys/mounts/" ++ T.unpack mountPoint) headers (Just reqBody) [200] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -504,7 +536,7 @@ -- | vaultUnmount :: VaultConnection -> Text -> IO () vaultUnmount VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} mountPoint = do - _ <- vaultRequest _VaultConnection_Manager "DELETE" (vaultUrl _VaultConnection_VaultAddress "/sys/mounts/" ++ T.unpack mountPoint) headers (Nothing :: Maybe ()) [204] + _ <- vaultRequest _VaultConnection_Manager "DELETE" (vaultUrl _VaultConnection_VaultAddress "/sys/mounts/" ++ T.unpack mountPoint) headers (Nothing :: Maybe ()) [200] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -528,9 +560,10 @@ -- -- The value that you give must encode as a JSON object vaultWrite :: ToJSON a => VaultConnection -> VaultSecretPath -> a -> IO () -vaultWrite VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath location) value = do +vaultWrite VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath (mountedPath, searchPath)) value = do let reqBody = value - _ <- vaultRequest _VaultConnection_Manager "POST" (vaultUrl _VaultConnection_VaultAddress "/" ++ T.unpack location) headers (Just reqBody) [204] + let path = vaultActionUrl Create _VaultConnection_VaultAddress mountedPath searchPath + _ <- vaultRequest _VaultConnection_Manager "POST" path headers (Just reqBody) [200, 204] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -554,8 +587,8 @@ -- the error message -- from the parse -- failure -vaultRead VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath location) = do - let path = vaultUrl _VaultConnection_VaultAddress "/" ++ T.unpack location +vaultRead VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath (mountedPath, searchPath)) = do + let path = vaultActionUrl ReadMetadata _VaultConnection_VaultAddress mountedPath searchPath rspObj <- vaultRequestJSON _VaultConnection_Manager "GET" path headers (Nothing :: Maybe ()) [200] case parseEither parseJSON (Object rspObj) of Left err -> throwIO $ VaultException_ParseBodyError "GET" path (encode rspObj) err @@ -570,8 +603,9 @@ -- | vaultDelete :: VaultConnection -> VaultSecretPath -> IO () -vaultDelete VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath location) = do - _ <- vaultRequest _VaultConnection_Manager "DELETE" (vaultUrl _VaultConnection_VaultAddress "/" ++ T.unpack location) headers (Nothing :: Maybe ()) [204] +vaultDelete VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath (mountedPath, searchPath)) = do + let path = vaultActionUrl DeleteMetadata _VaultConnection_VaultAddress mountedPath searchPath + _ <- vaultRequest _VaultConnection_Manager "DELETE" path headers (Nothing :: Maybe ()) [204] pure () where headers = [authTokenHeader _VaultConnection_AuthToken] @@ -598,23 +632,26 @@ -- -- To recursively retrieve all of the secrets use 'vaultListRecursive' vaultList :: VaultConnection -> VaultSecretPath -> IO [VaultSecretPath] -vaultList VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath location) = do - VaultListResult keys <- vaultRequestJSON _VaultConnection_Manager "LIST" (vaultUrl _VaultConnection_VaultAddress "/" ++ T.unpack location) headers (Nothing :: Maybe ()) [200] - pure $ map (VaultSecretPath . (withTrailingSlash `T.append`)) keys +vaultList VaultConnection{_VaultConnection_VaultAddress, _VaultConnection_Manager, _VaultConnection_AuthToken} (VaultSecretPath (VaultMountedPath mountedPath, VaultSearchPath searchPath)) = do + let path = vaultActionUrl ListSecrets _VaultConnection_VaultAddress (VaultMountedPath mountedPath) (VaultSearchPath searchPath) + VaultListResult keys <- vaultRequestJSON _VaultConnection_Manager "LIST" path headers (Nothing :: Maybe ()) [200] + pure $ map (VaultSecretPath . fullSecretPath) keys where headers = [authTokenHeader _VaultConnection_AuthToken] + fullSecretPath key = (VaultMountedPath mountedPath, VaultSearchPath (withTrailingSlash `T.append` key)) withTrailingSlash - | T.null location = "/" - | T.last location == '/' = location - | otherwise = location `T.snoc` '/' + | T.null searchPath = "/" + | T.last searchPath == '/' = searchPath + | otherwise = searchPath `T.snoc` '/' + -- | Does the path end with a '/' character? -- -- Meant to be used on the results of 'vaultList' isFolder :: VaultSecretPath -> Bool -isFolder (VaultSecretPath path) - | T.null path = False - | otherwise = T.last path == '/' +isFolder (VaultSecretPath (_, VaultSearchPath searchPath)) + | T.null searchPath = False + | otherwise = T.last searchPath == '/' -- | Recursively calls 'vaultList' to retrieve all of the secrets in a folder -- (including all subfolders and sub-subfolders, etc...) diff --git a/src/Network/VaultTool/Types.hs b/src/Network/VaultTool/Types.hs --- a/src/Network/VaultTool/Types.hs +++ b/src/Network/VaultTool/Types.hs @@ -22,7 +22,13 @@ text <- parseJSON j pure (VaultAuthToken text) -newtype VaultSecretPath = VaultSecretPath { unVaultSecretPath :: Text } +newtype VaultMountedPath = VaultMountedPath { unVaultMountedPath :: Text } + deriving (Show, Eq, Ord) + +newtype VaultSearchPath = VaultSearchPath { unVaultSearchPath :: Text } + deriving (Show, Eq, Ord) + +newtype VaultSecretPath = VaultSecretPath (VaultMountedPath, VaultSearchPath) deriving (Show, Eq, Ord) newtype VaultAppRoleId = VaultAppRoleId { unVaultAppRoleId :: Text } diff --git a/vault-tool.cabal b/vault-tool.cabal --- a/vault-tool.cabal +++ b/vault-tool.cabal @@ -1,5 +1,5 @@ name: vault-tool -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Client library for HashiCorp's Vault tool (via HTTP API) description: Client library for HashiCorp's Vault tool (via HTTP API) license: MIT @@ -24,7 +24,7 @@ other-modules: Network.VaultTool.Internal, Network.VaultTool.Types - build-depends: base >=4.8 && <4.11, + build-depends: base >=4.8 && < 5, text, bytestring, http-client,