secretspec (empty) → 0.13.0
raw patch · 4 files changed
+882/−0 lines, 4 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, containers, directory, filepath, process, secretspec, text
Files
- LICENSE +201/−0
- secretspec.cabal +51/−0
- src/SecretSpec.hs +357/−0
- test/Main.hs +273/−0
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ secretspec.cabal view
@@ -0,0 +1,51 @@+cabal-version: 2.4+name: secretspec+version: 0.13.0+synopsis: Haskell SDK for SecretSpec, a declarative secrets manager+description:+ A thin client over the @secretspec-ffi@ C ABI (linked at build time).+ Resolution (providers, chains, profiles, generation, @as_path@) happens in the+ Rust core; this package marshals a JSON request to the native library and+ parses the response, mirroring the Rust derive crate's vocabulary.+homepage: https://secretspec.dev/+license: Apache-2.0+license-file: LICENSE+author: Domen Kožar+maintainer: domen@enlambda.com+category: Configuration+build-type: Simple++library+ exposed-modules: SecretSpec+ hs-source-dirs: src+ build-depends: base >=4.14 && <5+ , aeson >=2.0 && <3+ , bytestring <1+ , containers <1+ , directory <2+ , text <3+ -- The native resolver, statically linked at build time. Point --extra-lib-dirs+ -- at a directory containing ONLY libsecretspec_ffi.a (so -lsecretspec_ffi+ -- resolves to the archive, not a co-located .so), and pass the archive's+ -- transitive native deps via --ghc-options=-optl<lib> (capture them with+ -- `cargo rustc -p secretspec-ffi --crate-type staticlib -- --print native-static-libs`).+ -- The Rust code is embedded in the binary, so no LD_LIBRARY_PATH is needed.+ extra-libraries: secretspec_ffi+ default-language: Haskell2010+ ghc-options: -Wall++test-suite secretspec-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ build-depends: base+ , secretspec+ , aeson >=2.0+ , bytestring+ , containers+ , directory+ , filepath+ , process+ , text+ default-language: Haskell2010+ ghc-options: -Wall -threaded
+ src/SecretSpec.hs view
@@ -0,0 +1,357 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Haskell SDK for SecretSpec, a declarative secrets manager.+--+-- A thin client over the @secretspec-ffi@ C ABI, linked at build time.+-- Resolution (providers, fallback chains, profiles, generation, @as_path@)+-- happens entirely in the Rust core; this module marshals a JSON request to+-- @secretspec_resolve@, parses the response envelope, and exposes it with the+-- same vocabulary as the Rust derive crate.+--+-- > import qualified SecretSpec as S+-- > import Data.Function ((&))+-- >+-- > main = do+-- > resolved <- S.load (S.builder & S.withProvider "keyring://" & S.withReason "boot")+-- > print (S.get =<< Data.Map.lookup "DATABASE_URL" (S.resolvedSecrets resolved))+-- > S.setAsEnv resolved+module SecretSpec+ ( -- * Builder+ Builder+ , builder+ , withPath+ , withProvider+ , withProfile+ , withReason+ , withNoValues+ -- * Resolve (value-carrying)+ , Resolved(..)+ , ResolvedSecret(..)+ , load+ , get+ , fields+ , fieldsJson+ , setAsEnv+ , close+ -- * Report (value-free)+ , Report(..)+ , SecretReport(..)+ , report+ -- * Errors+ , SecretSpecError(..)+ , MissingRequiredError(..)+ -- * Misc+ , abiVersion+ ) where++import Control.Exception (Exception, finally, mask, throwIO)+import Control.Monad (forM_, unless, when)+import Data.Aeson (FromJSON (..), Value, eitherDecodeStrict, encode,+ object, withObject, (.!=), (.:), (.:?), (.=))+import Data.Aeson.Types (parseEither)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Data.Text as T+import Foreign.C.String (CString, peekCString)+import Foreign.Ptr (nullPtr)+import System.Directory (doesFileExist, removeFile)+import qualified System.Environment.Blank as Env++-- The three C ABI functions, statically linked at build time (the archive+-- libsecretspec_ffi.a is embedded; -lsecretspec_ffi resolves to it). They are+-- declared @safe@ because @secretspec_resolve@ may block on provider I/O+-- (1Password, LastPass), and a @safe@ call lets other Haskell threads run.+foreign import ccall safe "secretspec_resolve"+ c_secretspec_resolve :: CString -> IO CString++foreign import ccall safe "secretspec_free"+ c_secretspec_free :: CString -> IO ()++foreign import ccall safe "secretspec_abi_version"+ c_secretspec_abi_version :: IO CString++-- | Wire-format version of the value-carrying resolve response this SDK+-- understands. Tracks @secretspec@'s @RESOLVE_SCHEMA_VERSION@.+resolveSchemaVersion :: Int+resolveSchemaVersion = 1++-- | Wire-format version of the value-free report. Tracks @secretspec@'s+-- @RESOLUTION_REPORT_SCHEMA_VERSION@.+reportSchemaVersion :: Int+reportSchemaVersion = 1++-- | A resolution failure (bad manifest, provider error, reason policy). Carries+-- a stable @kind@.+data SecretSpecError = SecretSpecError+ { errorKind :: Text+ , errorMessage :: Text+ } deriving (Show, Eq)++instance Exception SecretSpecError++-- | One or more required secrets were not found anywhere.+newtype MissingRequiredError = MissingRequiredError+ { missing :: [Text]+ } deriving (Show, Eq)++instance Exception MissingRequiredError++-- | One resolved secret. Exactly one of 'secretValue' \/ 'secretPath' is set:+-- the path for @as_path@ secrets, the value otherwise. Both are 'Nothing' for a+-- value-less ('withNoValues') response.+data ResolvedSecret = ResolvedSecret+ { secretValue :: Maybe Text+ , secretPath :: Maybe Text+ , secretAsPath :: Bool+ , secretSource :: Text+ , secretSourceProvider :: Maybe Text+ } deriving (Show, Eq)++instance FromJSON ResolvedSecret where+ parseJSON = withObject "ResolvedSecret" $ \o ->+ ResolvedSecret+ <$> o .:? "value"+ <*> o .:? "path"+ <*> o .:? "as_path" .!= False+ <*> o .: "source"+ <*> o .:? "source_provider"++-- | A successful resolution, mirroring the Rust @Resolved@ wrapper.+data Resolved = Resolved+ { resolvedProvider :: Text+ , resolvedProfile :: Text+ , resolvedSecrets :: Map Text ResolvedSecret+ , resolvedMissingOptional :: [Text]+ } deriving (Show, Eq)++-- | The value-free resolution outcome for one declared secret: how it would+-- resolve and from where, never the value itself.+data SecretReport = SecretReport+ { srName :: Text+ , srStatus :: Text -- ^ @"resolved"@, @"missing_required"@, or @"missing_optional"@.+ , srRequired :: Bool+ , srSourceProvider :: Maybe Text+ , srDefaultApplied :: Bool+ , srGenerated :: Bool+ , srAsPath :: Bool+ } deriving (Show, Eq)++instance FromJSON SecretReport where+ parseJSON = withObject "SecretReport" $ \o ->+ SecretReport+ <$> o .: "name"+ <*> o .: "status"+ <*> o .:? "required" .!= False+ <*> o .:? "source_provider"+ <*> o .:? "default_applied" .!= False+ <*> o .:? "generated" .!= False+ <*> o .:? "as_path" .!= False++-- | A value-free resolution snapshot. Unlike 'Resolved', a missing required+-- secret is a @"missing_required"@ status here, not an error.+data Report = Report+ { reportProvider :: Text+ , reportProfile :: Text+ , reportSecrets :: [SecretReport]+ } deriving (Show, Eq)++-- | A resolution request. Build it from 'builder' with the @withX@ setters and+-- pass it to 'load' or 'report'.+data Builder = Builder+ { bPath :: Maybe Text+ , bProvider :: Maybe Text+ , bProfile :: Maybe Text+ , bReason :: Maybe Text+ , bNoValues :: Bool+ }++-- | A builder with no options set.+builder :: Builder+builder = Builder Nothing Nothing Nothing Nothing False++-- | Resolve from a manifest at this path instead of walking up from the working+-- directory.+withPath :: Text -> Builder -> Builder+withPath v b = b { bPath = Just v }++-- | Override the provider (a @keyring:\/\/@-style URI or a configured alias).+withProvider :: Text -> Builder -> Builder+withProvider v b = b { bProvider = Just v }++-- | Override the profile.+withProfile :: Text -> Builder -> Builder+withProfile v b = b { bProfile = Just v }++-- | Set a human-readable reason for this access (for audited providers).+withReason :: Text -> Builder -> Builder+withReason v b = b { bReason = Just v }++-- | Omit secret values, returning only structure and provenance.+withNoValues :: Bool -> Builder -> Builder+withNoValues v b = b { bNoValues = v }++-- | The usable string: the file path for @as_path@ secrets, else the value.+-- 'Nothing' when no usable value is present (e.g. under 'withNoValues').+get :: ResolvedSecret -> Maybe Text+get s = if secretAsPath s then secretPath s else secretValue s++-- | Flat @name -> usable value@ map ('Nothing' encodes to JSON @null@), the+-- input for a quicktype-generated deserializer. See @secretspec schema@.+fields :: Resolved -> Map Text (Maybe Text)+fields = Map.map get . resolvedSecrets++-- | 'fields' as a JSON byte string (a @{SECRET_NAME: value-or-null}@ object).+fieldsJson :: Resolved -> BL.ByteString+fieldsJson = encode . fields++-- | Export each resolved secret into the process environment by its declared+-- name. Secrets with no usable value (e.g. under 'withNoValues') are skipped.+setAsEnv :: Resolved -> IO ()+setAsEnv r =+ forM_ (Map.toList (resolvedSecrets r)) $ \(name, secret) ->+ case get secret of+ -- System.Environment.setEnv treats setEnv name "" as unsetEnv name, which+ -- would *delete* a secret that resolves to "" (e.g. `.env` line `FOO=` or+ -- `default = ""`). System.Environment.Blank.setEnv with overwrite=True sets+ -- the empty string, matching the Go/Python/Ruby/Node SDKs.+ Just v -> Env.setEnv (T.unpack name) (T.unpack v) True+ Nothing -> pure ()++-- | Remove the temp files backing any @as_path@ secrets in this result. The+-- resolver persists those files (mode 0400) so their paths stay valid after+-- resolve returns; the caller owns their lifetime. Call 'close' when done so the+-- secret files do not accumulate in the temp dir. A file already gone is ignored.+close :: Resolved -> IO ()+close r =+ forM_ (Map.elems (resolvedSecrets r)) $ \secret ->+ case (secretAsPath secret, secretPath secret) of+ (True, Just p) -> do+ let fp = T.unpack p+ exists <- doesFileExist fp+ when exists (removeFile fp)+ _ -> pure ()++-- | The ABI version reported by the loaded native library.+abiVersion :: IO Text+abiVersion = do+ -- A static, library-owned string; do not free it.+ c <- c_secretspec_abi_version+ T.pack <$> peekCString c++-- | Resolve the secrets. Throws 'MissingRequiredError' if a required secret is+-- missing, and 'SecretSpecError' for any other failure.+load :: Builder -> IO Resolved+load b = do+ resp <- callNative (requestBytes b Nothing)+ value <- responseValue resp resolveSchemaVersion "resolve"+ (prov, prof, secs, mreq, mopt) <- fromResult (parseEither pResolve value)+ case mreq of+ [] -> pure (Resolved prov prof secs mopt)+ xs -> throwIO (MissingRequiredError xs)+ where+ pResolve = withObject "response" $ \o ->+ (,,,,)+ <$> o .: "provider"+ <*> o .: "profile"+ <*> o .:? "secrets" .!= Map.empty+ <*> o .:? "missing_required" .!= []+ <*> o .:? "missing_optional" .!= []++-- | Resolve a value-free 'Report' (the inventory\/preflight view, the same one+-- the CLI exposes as @check --json@). Unlike 'load', it does not throw when a+-- required secret is missing: that secret appears as a 'SecretReport' with+-- status @"missing_required"@.+report :: Builder -> IO Report+report b = do+ resp <- callNative (requestBytes b (Just "report"))+ value <- responseValue resp reportSchemaVersion "report"+ (prov, prof, secs) <- fromResult (parseEither pReport value)+ pure (Report prov prof secs)+ where+ pReport = withObject "response" $ \o ->+ (,,)+ <$> o .: "provider"+ <*> o .: "profile"+ <*> o .:? "secrets" .!= []++-- Build the request JSON for a resolve (@mode = Nothing@) or report+-- (@mode = Just "report"@), omitting unset options.+requestBytes :: Builder -> Maybe Text -> BL.ByteString+requestBytes b mode =+ encode . object $+ catMaybes+ [ ("path" .=) <$> bPath b+ , ("provider" .=) <$> bProvider b+ , ("profile" .=) <$> bProfile b+ , ("reason" .=) <$> bReason b+ ]+ ++ ["no_values" .= True | bNoValues b]+ ++ ["mode" .= m | Just m <- [mode]]++-- Marshal a request to secretspec_resolve and copy the response out before+-- freeing the native allocation.+--+-- The response is a Rust allocation the caller must free, and it carries secret+-- values. @mask@ keeps an async exception (e.g. a 'System.Timeout.timeout'+-- around 'load') from landing between the call returning and the free being+-- installed, and @finally@ guarantees the free runs whether @packCString@+-- succeeds, throws, or is interrupted — so the secret-bearing buffer never leaks.+callNative :: BL.ByteString -> IO BS.ByteString+callNative reqLazy =+ BS.useAsCString (BL.toStrict reqLazy) $ \creq ->+ mask $ \restore -> do+ cresp <- c_secretspec_resolve creq+ if cresp == nullPtr+ then throwIO (SecretSpecError "ffi" "secretspec_resolve returned null")+ else restore (BS.packCString cresp) `finally` c_secretspec_free cresp++-- Decode the envelope, unwrap @ok@/@error@, and check the schema version,+-- returning the response object as a 'Value' for the caller to project.+responseValue :: BS.ByteString -> Int -> Text -> IO Value+responseValue resp expectVer kind = do+ env <- case eitherDecodeStrict resp :: Either String (Envelope Value) of+ Left e -> throwIO (SecretSpecError "parse" (T.pack e))+ Right v -> pure v+ if not (envOk env)+ then case envError env of+ Just (ErrInfo k m) -> throwIO (SecretSpecError k m)+ Nothing -> throwIO (SecretSpecError "unknown" "")+ else case envResponse env of+ Nothing -> throwIO (SecretSpecError "ffi" "secretspec_resolve reported ok with no response")+ Just value -> do+ ver <- fromResult (parseEither (withObject "response" (.: "schema_version")) value)+ unless (ver == expectVer) (throwIO (versionError ver expectVer kind))+ pure value++versionError :: Int -> Int -> Text -> SecretSpecError+versionError got expected kind =+ SecretSpecError "version" $+ T.concat+ [ "unsupported ", kind, " schema version ", T.pack (show got)+ , " (expected ", T.pack (show expected)+ , "); the secretspec-ffi library and this SDK are out of sync"+ ]++fromResult :: Either String a -> IO a+fromResult = either (throwIO . SecretSpecError "parse" . T.pack) pure++-- The response envelope shared by every native binding.+data Envelope a = Envelope+ { envOk :: Bool+ , envResponse :: Maybe a+ , envError :: Maybe ErrInfo+ }++instance FromJSON a => FromJSON (Envelope a) where+ parseJSON = withObject "Envelope" $ \o ->+ Envelope <$> o .: "ok" <*> o .:? "response" <*> o .:? "error"++data ErrInfo = ErrInfo Text Text++instance FromJSON ErrInfo where+ parseJSON = withObject "error" $ \o -> ErrInfo <$> o .: "kind" <*> o .: "message"
+ test/Main.hs view
@@ -0,0 +1,273 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Unit + cross-language conformance tests for the Haskell SDK. The native+-- resolver is statically linked, so no loader path is needed -- stage the+-- archive alone and pass its transitive native deps:+--+-- > cabal test --extra-lib-dirs="$DIR_WITH_ONLY_THE_A" \+-- > --ghc-options=-optl-ldbus-1 ... # libs from `--print native-static-libs`+module Main (main) where++import Control.Exception (SomeException, try)+import Control.Monad (filterM, forM)+import Data.Aeson (Value, eitherDecode, eitherDecodeStrict, object,+ (.=))+import qualified Data.Aeson.Key as Key+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Function ((&))+import Data.List (isInfixOf, isPrefixOf, sort)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe, isJust)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified SecretSpec as S+import System.Directory (canonicalizePath, createDirectoryIfMissing,+ doesDirectoryExist, findExecutable,+ getTemporaryDirectory, listDirectory)+import System.Environment (lookupEnv)+import System.Exit (exitFailure, exitSuccess)+import System.FilePath ((</>))+import System.Process (callProcess, readProcess)++main :: IO ()+main = do+ fixturesDir <- canonicalizePath ("." </> ".." </> "conformance" </> "fixtures")+ names <- listDirectory fixturesDir+ fixtures <- filterM doesDirectoryExist (map (fixturesDir </>) (sort names))++ let tests =+ [ ("abi_version_nonempty", testAbiVersion)+ , ("missing_required_throws", testMissingRequired)+ , ("codegen", testCodegen)+ ]+ ++ concatMap conformanceTests fixtures++ results <- mapM runOne tests+ let failed = [name | (name, ok) <- results, not ok]+ putStrLn ""+ putStrLn (show (length results - length failed) ++ "/" ++ show (length results) ++ " passed")+ if null failed+ then exitSuccess+ else putStrLn ("FAILED: " ++ unwords failed) >> exitFailure++runOne :: (String, IO ()) -> IO (String, Bool)+runOne (name, act) = do+ r <- try act :: IO (Either SomeException ())+ case r of+ Right () -> putStrLn ("ok " ++ name) >> pure (name, True)+ Left e -> putStrLn ("FAIL " ++ name ++ ": " ++ show e) >> pure (name, False)++expect :: Bool -> String -> IO ()+expect True _ = pure ()+expect False msg = ioError (userError msg)++-- Unit tests --------------------------------------------------------------++testAbiVersion :: IO ()+testAbiVersion = do+ v <- S.abiVersion+ expect (not (T.null v)) "abi version was empty"++testMissingRequired :: IO ()+testMissingRequired = do+ tmp <- getTemporaryDirectory+ let dir = tmp </> "secretspec-hs-missing"+ createDirectoryIfMissing True dir+ writeFile (dir </> "secretspec.toml") $+ unlines+ [ "[project]"+ , "name = \"hs-missing\""+ , "revision = \"1.0\""+ , ""+ , "[profiles.default]"+ , "NEEDED = { description = \"x\", required = true }"+ ]+ writeFile (dir </> ".env") ""+ r <-+ try (S.load (fixtureBuilder dir)) ::+ IO (Either S.MissingRequiredError S.Resolved)+ case r of+ Left _ -> pure ()+ Right _ -> ioError (userError "expected MissingRequiredError")++-- End-to-end codegen: secretspec schema -> quicktype --lang haskell -> compile+-- the generated module and decode the SDK's own fieldsJson output with it, so+-- the schema -> fields() linkage is exercised, not just hand-written JSON. Skips+-- unless SECRETSPEC_BIN, npx, runghc, and a cabal-written GHC environment file+-- (so runghc sees aeson and the generated module's transitive imports) are all+-- present -- i.e. when run via `cabal test --write-ghc-environment-files=always`+-- with SECRETSPEC_BIN set, as scripts/ci-sdks.sh does.+testCodegen :: IO ()+testCodegen = do+ mbin <- lookupEnv "SECRETSPEC_BIN"+ npx <- findExecutable "npx"+ rghc <- findExecutable "runghc"+ hasEnv <- any (isPrefixOf ".ghc.environment.") <$> listDirectory "."+ case (mbin, npx, rghc, hasEnv) of+ (Just bin, Just _, Just _, True) -> runCodegen bin+ _ -> putStrLn " (skipped: needs SECRETSPEC_BIN, npx, runghc, and a ghc env file)"++runCodegen :: FilePath -> IO ()+runCodegen bin = do+ tmp <- getTemporaryDirectory+ let dir = tmp </> "secretspec-hs-codegen"+ createDirectoryIfMissing True dir+ writeFile (dir </> "secretspec.toml") $+ unlines+ [ "[project]"+ , "name = \"hs-codegen\""+ , "revision = \"1.0\""+ , ""+ , "[profiles.default]"+ , "DATABASE_URL = { required = true }"+ , "LOG_LEVEL = { required = false, default = \"info\" }"+ ]+ writeFile (dir </> ".env") "DATABASE_URL=postgres://db\n"++ -- The SDK itself produces the flat fields JSON the generated decoder consumes,+ -- so this exercises the real schema -> fields() linkage.+ resolved <-+ S.load+ ( S.builder+ & S.withPath (T.pack (dir </> "secretspec.toml"))+ & S.withProvider (T.pack ("dotenv://" ++ (dir </> ".env")))+ & S.withReason "codegen"+ )+ BL.writeFile (dir </> "fields.json") (S.fieldsJson resolved)++ callProcess bin ["-f", dir </> "secretspec.toml", "schema", "-o", dir </> "schema.json"]+ callProcess+ "npx"+ [ "--yes", "quicktype", "-s", "schema", dir </> "schema.json"+ , "--top-level", "SecretSpec", "--lang", "haskell"+ , "--module", "Secrets", "-o", dir </> "Secrets.hs"+ ]+ writeFile (dir </> "Driver.hs") driverSource++ out <- readProcess "runghc" ["-i" ++ dir, dir </> "Driver.hs", dir </> "fields.json"] ""+ expect ("codegen OK" `isInfixOf` out) ("unexpected driver output: " ++ out)++-- A standalone program that decodes the SDK's fields JSON with the+-- quicktype-generated SecretSpec type, proving the generated code is usable.+driverSource :: String+driverSource =+ unlines+ [ "{-# LANGUAGE OverloadedStrings #-}"+ , "import Secrets (SecretSpec(..), decodeTopLevel)"+ , "import qualified Data.ByteString.Lazy as BL"+ , "import System.Environment (getArgs)"+ , "import System.Exit (exitFailure)"+ , "main :: IO ()"+ , "main = do"+ , " [f] <- getArgs"+ , " bytes <- BL.readFile f"+ , " case decodeTopLevel bytes of"+ , " Just s | databaseURLSecretSpec s == \"postgres://db\" -> putStrLn \"codegen OK\""+ , " _ -> exitFailure"+ ]++-- Conformance -------------------------------------------------------------++conformanceTests :: FilePath -> [(String, IO ())]+conformanceTests dir =+ [ ("conformance:" ++ base, testConformance dir)+ , ("conformance_no_values:" ++ base, testNoValues dir)+ , ("conformance_report:" ++ base, testReport dir)+ ]+ where+ base = lastSegment dir++testConformance :: FilePath -> IO ()+testConformance dir = do+ resolved <- S.load (fixtureBuilder dir)+ actual <- canonical resolved+ expected <- readJson (dir </> "expected.json")+ expect (actual == expected) (mismatch "expected.json" actual expected)+ -- Remove any as_path temp files this value-carrying resolve materialized, so+ -- repeated runs do not leave secret-bearing files behind in the temp dir.+ S.close resolved++-- Under no_values every SDK must emit the same all-null fields map: a+-- value-less secret serializes to null, not an empty string.+testNoValues :: FilePath -> IO ()+testNoValues dir = do+ resolved <- S.load (S.withNoValues True (fixtureBuilder dir))+ let actual = either error id (eitherDecode (S.fieldsJson resolved)) :: Value+ expected <- readJson (dir </> "expected_no_values.json")+ expect (actual == expected) (mismatch "expected_no_values.json" actual expected)+ S.close resolved++-- The value-free report (status + provenance) is identical across SDKs.+testReport :: FilePath -> IO ()+testReport dir = do+ rep <- S.report (fixtureBuilder dir)+ let actual = canonicalReport rep+ expected <- readJson (dir </> "expected_report.json")+ expect (actual == expected) (mismatch "expected_report.json" actual expected)++fixtureBuilder :: FilePath -> S.Builder+fixtureBuilder dir =+ S.builder+ & S.withPath (T.pack (dir </> "secretspec.toml"))+ & S.withProvider (T.pack ("dotenv://" ++ (dir </> ".env")))+ & S.withReason "conformance"++canonical :: S.Resolved -> IO Value+canonical r = do+ entries <-+ forM (Map.toList (S.resolvedSecrets r)) $ \(name, secret) -> do+ value <-+ if S.secretAsPath secret+ then TIO.readFile (T.unpack (fromMaybe "" (S.secretPath secret)))+ else pure (fromMaybe "" (S.secretValue secret))+ pure+ ( Key.fromText name+ .= object+ [ "value" .= value+ , "source" .= S.secretSource secret+ , "as_path" .= S.secretAsPath secret+ ]+ )+ pure $+ object+ [ "profile" .= S.resolvedProfile r+ , "secrets" .= object entries+ , "missing_required" .= ([] :: [Text])+ , "missing_optional" .= sort (S.resolvedMissingOptional r)+ ]++canonicalReport :: S.Report -> Value+canonicalReport rep =+ object+ [ "profile" .= S.reportProfile rep+ , "secrets"+ .= object+ [ Key.fromText (S.srName s)+ .= object+ [ "status" .= S.srStatus s+ , "required" .= S.srRequired s+ , "as_path" .= S.srAsPath s+ , "generated" .= S.srGenerated s+ , "default_applied" .= S.srDefaultApplied s+ , -- Present-or-not (not the path-dependent value) so the vector+ -- is machine-independent yet still catches a dropped provider.+ "source_provider" .= isJust (S.srSourceProvider s)+ ]+ | s <- S.reportSecrets rep+ ]+ ]++readJson :: FilePath -> IO Value+readJson p = do+ bytes <- BS.readFile p+ either (ioError . userError) pure (eitherDecodeStrict bytes)++mismatch :: String -> Value -> Value -> String+mismatch name actual expected =+ name ++ " mismatch\n got: " ++ show actual ++ "\nwant: " ++ show expected++lastSegment :: FilePath -> String+lastSegment = reverse . takeWhile (/= '/') . reverse