aws-secrets (empty) → 0.0.0.0

raw patch · 13 files changed

+546/−0 lines, 13 filesdep +aesondep +aws-secretsdep +base

Dependencies added: aeson, aws-secrets, base, bytestring, containers, hspec, mtl, scientific, stm, text, typed-process, validation

Files

• aws-secrets.cabal +69/−0
• changelog.md +1/−0
• library/AWS/Secrets.hs +55/−0
• library/AWS/Secrets/Config.hs +57/−0
• library/AWS/Secrets/Fetch.hs +163/−0
• library/AWS/Secrets/Key.hs +16/−0
• library/AWS/Secrets/Name.hs +15/−0
• library/AWS/Secrets/Reader.hs +77/−0
• library/AWS/Secrets/SecretType.hs +42/−0
• license.txt +18/−0
• readme.md +4/−0
• test/Main.hs +19/−0
• test/payload.json +10/−0

@@ -0,0 +1,69 @@+cabal-version: 3.0++name: aws-secrets+version: 0.0.0.0+category: AWS, Password+synopsis: Fetch data from AWS Secrets Manager++description:+    This library can be used to fetch data from AWS Secrets Manager.+    It depends on the AWS Command Line Interface.++copyright: 2023 Mission Valley Software LLC+license: MIT+license-file: license.txt++author: Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage: https://github.com/typeclasses/aws-secrets++extra-source-files:+    *.md+    test/*.json++common base+    default-language: GHC2021+    ghc-options:+        -Wall+        -Wmissing-deriving-strategies+    default-extensions:+        BlockArguments+        DerivingVia+        LambdaCase+        NoImplicitPrelude+        OverloadedLists+        OverloadedStrings+        QuasiQuotes+    build-depends:+      , aeson >= 2.0.3+      , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18+      , bytestring ^>= 0.11+      , containers ^>= 0.6.5+      , mtl ^>= 2.2.2 || ^>= 2.3+      , scientific ^>= 0.3.6+      , stm ^>= 2.5+      , text ^>= 1.2.5 || ^>= 2.0+      , typed-process ^>= 0.2.10+      , validation ^>= 1.1++library+    import: base+    hs-source-dirs: library+    exposed-modules:+        AWS.Secrets+        AWS.Secrets.Config+        AWS.Secrets.Fetch+        AWS.Secrets.Key+        AWS.Secrets.Name+        AWS.Secrets.Reader+        AWS.Secrets.SecretType++test-suite test-aws-secrets+    import: base+    type: exitcode-stdio-1.0+    hs-source-dirs: test+    main-is: Main.hs+    build-depends:+      , aws-secrets+      , hspec ^>= 2.9 || ^>= 2.10 || ^>= 2.11

@@ -0,0 +1,1 @@+0.0.0.0 - 2023-06-01 - Initial release

@@ -0,0 +1,55 @@+module AWS.Secrets+  ( getSecret,+    getSecretOrFail,+    SecretsConfig,+    SecretReader,+    SecretKey,+    SecretName,+  )+where++import AWS.Secrets.Config (SecretsConfig)+import AWS.Secrets.Fetch (fetchSecret)+import AWS.Secrets.Key (SecretKey)+import AWS.Secrets.Name (SecretName)+import AWS.Secrets.Reader (SecretReader)+import qualified AWS.Secrets.Reader as Reader+import AWS.Secrets.SecretType (Secret, getSecretValue)+import Control.Applicative (pure)+import Control.Monad ((>>=))+import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)+import Control.Monad.Fail (fail)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Either (either)+import Data.Foldable (toList)+import Data.Function+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Validation (validation)+import System.IO (IO)++getSecret ::+  (MonadIO m, MonadError (Seq Text) m) =>+  SecretsConfig ->+  SecretName ->+  SecretReader a ->+  m a+getSecret config name reader = do+  s :: Secret <- modifyError Seq.singleton $ fetchSecret config name+  Reader.apply reader (getSecretValue s) & validation throwError pure++getSecretOrFail ::+  (MonadIO m) =>+  SecretsConfig ->+  SecretName ->+  SecretReader a ->+  m a+getSecretOrFail config name reader =+  runExceptT (getSecret config name reader)+    >>= either (liftIO . fail @IO . Text.unpack . Text.unlines . toList) pure++-- This can be gotten from "Control.Monad.Except" after upgrading to mtl 2.3.1+modifyError :: MonadError e' m => (e -> e') -> ExceptT e m a -> m a+modifyError f m = runExceptT m >>= either (throwError . f) pure

@@ -0,0 +1,57 @@+{- |++This library uses the AWS Command Line Interface. By default, this is+expected to be found as an executable called "aws" on the binary PATH.+This can be customized using 'setAwsCli'.++-}+module AWS.Secrets.Config+  ( SecretsConfig,+    secretsConfig,++    -- ** Region+    AwsRegion (..),+    getAwsRegion,+    getAwsRegionText,++    -- ** AWS command-line tool+    getAwsCli,+    setAwsCli,+    AwsCli (..),+    getAwsCliFilePath,+  )+where++import Data.Text (Text)+import System.IO (FilePath)++data SecretsConfig = SecretConfig+  { secretsConfigAwsCli :: AwsCli,+    secretsConfigAwsRegion :: AwsRegion+  }++newtype AwsCli = AwsCli FilePath++newtype AwsRegion = AwsRegion Text++defaultAwsCli :: AwsCli+defaultAwsCli = AwsCli "aws"++secretsConfig :: AwsRegion -> SecretsConfig+secretsConfig secretsConfigAwsRegion =+  SecretConfig {secretsConfigAwsCli = defaultAwsCli, secretsConfigAwsRegion}++setAwsCli :: AwsCli -> SecretsConfig -> SecretsConfig+setAwsCli secretsConfigAwsCli config = config {secretsConfigAwsCli}++getAwsCli :: SecretsConfig -> AwsCli+getAwsCli = secretsConfigAwsCli++getAwsRegion :: SecretsConfig -> AwsRegion+getAwsRegion = secretsConfigAwsRegion++getAwsCliFilePath :: AwsCli -> FilePath+getAwsCliFilePath (AwsCli x) = x++getAwsRegionText :: AwsRegion -> Text+getAwsRegionText (AwsRegion x) = x

@@ -0,0 +1,163 @@+module AWS.Secrets.Fetch where++import AWS.Secrets.Config (SecretsConfig)+import qualified AWS.Secrets.Config as Config+import AWS.Secrets.Name (SecretName, getSecretNameText)+import Control.Applicative (pure)+import Control.Monad.Except (MonadError, throwError)+import Control.Monad.IO.Class (MonadIO)+import qualified Data.Aeson as JSON+import qualified Data.ByteString.Lazy as Lazy+import qualified Data.ByteString.Lazy as Lazy.ByteString+import Data.Either (Either (..))+import Data.Foldable (fold)+import Data.Function (($), (.))+import Data.Int (Int)+import qualified Data.List as List+import Data.Semigroup ((<>))+import Data.String (String)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as Lazy.Text+import qualified Data.Text.Lazy.Builder as Text+import qualified Data.Text.Lazy.Builder as Text.Builder+import qualified System.Exit as Exit+import System.IO (FilePath)+import qualified System.Process.Typed as Process+import Text.Show (Show, show)++-- | Type @result@ may be e.g. 'AWS.Secrets.SecretType.Secret'.+fetchSecret ::+  forall m result.+  (MonadIO m, MonadError Text m, JSON.FromJSON result) =>+  SecretsConfig ->+  SecretName ->+  m result+fetchSecret config name = do+  let secretNameText :: Text+      secretNameText = getSecretNameText name++      secretNameString :: String+      secretNameString = Text.unpack secretNameText++      secretNameTextBuilder :: Text.Builder+      secretNameTextBuilder = Text.Builder.fromText secretNameText++      awsRegionText :: Text+      awsRegionText = Config.getAwsRegionText (Config.getAwsRegion config)++      awsRegionString :: String+      awsRegionString = Text.unpack awsRegionText++      awsRegionTextBuilder :: Text.Builder+      awsRegionTextBuilder = Text.Builder.fromText awsRegionText++      executableFilePath :: FilePath+      executableFilePath = Config.getAwsCliFilePath (Config.getAwsCli config)++      executableTextBuilder :: Text.Builder+      executableTextBuilder = Text.Builder.fromString executableFilePath++      stringArgs :: [String]+      stringArgs =+        [ "secretsmanager",+          "get-secret-value",+          "--secret-id",+          secretNameString,+          "--region",+          awsRegionString+        ]++      fullCommandTextBuilder :: Text.Builder+      fullCommandTextBuilder =+        unwords+          [ "The exact command executed was:",+            showBuilder @[String] (executableFilePath : stringArgs)+          ]++      descriptionTextBuilder :: Text.Builder+      descriptionTextBuilder =+        unwords+          [ "AWS command",+            quote executableTextBuilder,+            "to get secret",+            quote secretNameTextBuilder,+            "from region",+            quote $ awsRegionTextBuilder+          ]++  (exitCode :: Exit.ExitCode, output :: Lazy.ByteString, error :: Lazy.ByteString) <-+    Process.readProcess (Process.proc executableFilePath stringArgs)++  let -- Shows what came out on stdout+      normalOutputMessage :: Text.Builder+      normalOutputMessage =+        if Lazy.ByteString.null output+          then "It produced no output."+          else+            unwords+              [ "Its output was:",+                showBuilder @Lazy.ByteString output+              ]++      -- Shows what came out on stderr+      errorOutputMessage :: Text.Builder+      errorOutputMessage =+        if Lazy.ByteString.null error+          then "It produced no error output."+          else+            unwords+              [ "Its error output was:",+                showBuilder @Lazy.ByteString error+              ]++      -- What to do if the JSON on stdout couldn't be parsed+      throwParseError :: forall x. String -> m x+      throwParseError parseError =+        (throwError . render . unlines)+          [ unwords+              [ descriptionTextBuilder,+                "failed to produce valid JSON"+              ],+            fullCommandTextBuilder,+            normalOutputMessage,+            unwords+              [ "The output from the parser is:",+                Text.Builder.fromString parseError+              ]+          ]++      -- What to do if AWS command returns a failure exit code+      throwExitCodeError :: forall x. Int -> m x+      throwExitCodeError exitCodeInt =+        (throwError . render . unlines)+          [ unwords+              [ descriptionTextBuilder,+                "failed with exit code",+                quote (showBuilder @Int exitCodeInt)+              ],+            fullCommandTextBuilder,+            errorOutputMessage+          ]++  case exitCode of+    Exit.ExitSuccess -> case JSON.eitherDecode @result output of+      Right x -> pure x+      Left e -> throwParseError e+    Exit.ExitFailure exitCodeInt ->+      throwExitCodeError exitCodeInt++quote :: Text.Builder -> Text.Builder+quote x = "‘" <> x <> "’"++unwords :: [Text.Builder] -> Text.Builder+unwords = fold . List.intersperse " "++unlines :: [Text.Builder] -> Text.Builder+unlines = fold . List.intersperse "\n"++showBuilder :: Show a => a -> Text.Builder+showBuilder = Text.Builder.fromString . show++render :: Text.Builder -> Text+render = Lazy.Text.toStrict . Text.Builder.toLazyText

@@ -0,0 +1,16 @@+module AWS.Secrets.Key+  ( SecretKey (..),+    getSecretKeyText,+  )+where++import Data.String (IsString)+import Data.Text (Text)+import Prelude (Eq, Ord, Show)++-- | A secret can have multiple key/value pairs.+newtype SecretKey = SecretKeyText Text+  deriving newtype (IsString, Show, Eq, Ord)++getSecretKeyText :: SecretKey -> Text+getSecretKeyText (SecretKeyText x) = x

@@ -0,0 +1,15 @@+module AWS.Secrets.Name+  ( SecretName (..),+    getSecretNameText,+  )+where++import Data.String (IsString)+import Data.Text (Text)+import Prelude (Eq, Ord, Show)++newtype SecretName = SecretName Text+  deriving newtype (IsString, Show, Eq, Ord)++getSecretNameText :: SecretName -> Text+getSecretNameText (SecretName x) = x

@@ -0,0 +1,77 @@+module AWS.Secrets.Reader+  ( -- * Type+    SecretReader (..),+    bind,++    -- * Examples+    text,+    string,+    scientific,+    boundedInteger,+  )+where++import AWS.Secrets.Key (SecretKey, getSecretKeyText)+import Control.Applicative (Applicative, pure)+import qualified Data.Aeson as JSON+import qualified Data.Aeson.Key as JSON.Key+import Data.Function (($), (.))+import Data.Functor (Functor, fmap)+import Data.Functor.Compose (Compose (..))+import qualified Data.Aeson.KeyMap as KeyMap+import Data.Maybe (Maybe (..), maybe)+import Data.Scientific (Scientific)+import qualified Data.Scientific as Scientific+import Data.Semigroup ((<>))+import Data.Sequence (Seq)+import Data.String (String)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Validation (Validation (..), bindValidation)+import Prelude (Bounded, Integral)++newtype SecretReader a = SecretReader+  { apply :: JSON.Object -> Validation (Seq Text) a+  }+  deriving+    (Functor, Applicative)+    via Compose ((->) JSON.Object) (Validation (Seq Text))++bind :: SecretReader a -> (a -> SecretReader b) -> SecretReader b+bind (SecretReader f) g = SecretReader \o ->+  f o `bindValidation` (($ o) . apply . g)++---++text :: SecretKey -> SecretReader Text+text k = SecretReader \o ->+  orFail ["Missing: " <> getSecretKeyText k] (KeyMap.lookup (key k) o)+    `bindValidation` \txt -> orFail ["Not a string: " <> getSecretKeyText k] (castJsonString txt)++string :: SecretKey -> SecretReader String+string = fmap Text.unpack . text++scientific :: SecretKey -> SecretReader Scientific+scientific k = SecretReader \o ->+  orFail ["Missing: " <> getSecretKeyText k] (KeyMap.lookup (key k) o)+    `bindValidation` \txt -> orFail ["Not a string: " <> getSecretKeyText k] (castJsonNumber txt)++boundedInteger :: (Integral i, Bounded i) => SecretKey -> SecretReader i+boundedInteger k =+  scientific k `bind` \s -> SecretReader \_ -> case Scientific.toBoundedInteger s of+    Nothing -> Failure ["Not an integer or not within bounds: " <> getSecretKeyText k]+    Just i -> pure i++---++key :: SecretKey -> JSON.Key+key = JSON.Key.fromText . getSecretKeyText++castJsonString :: JSON.Value -> Maybe Text+castJsonString = \case JSON.String x -> Just x; _ -> Nothing++castJsonNumber :: JSON.Value -> Maybe Scientific+castJsonNumber = \case JSON.Number x -> Just x; _ -> Nothing++orFail :: Seq Text -> Maybe a -> Validation (Seq Text) a+orFail err = maybe (Failure err) Success

@@ -0,0 +1,42 @@+module AWS.Secrets.SecretType+  ( Secret,+    getSecretValue,+  )+where++import Data.Aeson ((.:))+import qualified Data.Aeson as JSON+import qualified Data.Aeson.Types as JSON+import qualified Data.ByteString.Lazy as Lazy.ByteString+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Prelude++-- | This type has a 'JSON.FromJSON' instance for use+-- with 'AWS.Secrets.Fetch.fetchSecret'.+data Secret = Secret+  { secretValue :: JSON.Object+  }++getSecretValue :: Secret -> JSON.Object+getSecretValue = secretValue++instance JSON.FromJSON Secret where+  parseJSON = \case+    JSON.Object v -> do+      SecretString ss <- v .: "SecretString"+      pure (Secret ss)+    invalid -> JSON.typeMismatch "Object" invalid++newtype SecretString = SecretString JSON.Object++instance JSON.FromJSON SecretString where+  parseJSON = \case+    JSON.String ss ->+      case decodeText @JSON.Object ss of+        Left e -> JSON.parserThrowError [] e+        Right x -> pure (SecretString x)+    invalid -> JSON.typeMismatch "String" invalid++decodeText :: forall a. JSON.FromJSON a => Text -> Either String a+decodeText = JSON.eitherDecode @a . Lazy.ByteString.fromStrict . encodeUtf8

@@ -0,0 +1,18 @@+Copyright 2023 Mission Valley Software LLC++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,4 @@+This library can be used to fetch data from+[AWS Secrets Manager](https://aws.amazon.com/secrets-manager/).+It depends on the+[AWS Command Line Interface](https://aws.amazon.com/cli/).

@@ -0,0 +1,19 @@+module Main (main) where++import AWS.Secrets.SecretType (getSecretValue)++import Control.Monad.IO.Class (liftIO)+import Data.Aeson ((.=))+import qualified Data.Aeson as JSON+import Data.Maybe (Maybe (..))+import Data.Text (Text)+import System.IO (IO)+import Test.Hspec (describe, hspec, specify, shouldBe)++main :: IO ()+main = hspec do+  describe "Secret FromJSON" do+    specify "parses the example payload" do+      Just s <- liftIO (JSON.decodeFileStrict' "test/payload.json")+      let expected = "API key" .= ("fpqjd41Fja9nVnar3sd" :: Text)+      getSecretValue s `shouldBe` expected

@@ -0,0 +1,10 @@+{+    "ARN": "arn:aws:secretsmanager:us-east-1:2734895:secret:WidgetService-Yg4Dah",+    "Name": "WidgetService",+    "VersionId": "b18acdcf-272b-4205-9eef-c28645e7e595",+    "SecretString": "{\"API key\":\"fpqjd41Fja9nVnar3sd\"}",+    "VersionStages": [+        "AWSCURRENT"+    ],+    "CreatedDate": "2021-03-04T14:42:42.150000-07:00"+}