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
  { Secret -> Object
secretValue :: JSON.Object
  }

getSecretValue :: Secret -> JSON.Object
getSecretValue :: Secret -> Object
getSecretValue = Secret -> Object
secretValue

instance JSON.FromJSON Secret where
  parseJSON :: Value -> Parser Secret
parseJSON = \case
    JSON.Object Object
v -> do
      SecretString Object
ss <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"SecretString"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Secret
Secret Object
ss)
    Value
invalid -> forall a. String -> Value -> Parser a
JSON.typeMismatch String
"Object" Value
invalid

newtype SecretString = SecretString JSON.Object

instance JSON.FromJSON SecretString where
  parseJSON :: Value -> Parser SecretString
parseJSON = \case
    JSON.String Text
ss ->
      case forall a. FromJSON a => Text -> Either String a
decodeText @JSON.Object Text
ss of
        Left String
e -> forall a. JSONPath -> String -> Parser a
JSON.parserThrowError [] String
e
        Right Object
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> SecretString
SecretString Object
x)
    Value
invalid -> forall a. String -> Value -> Parser a
JSON.typeMismatch String
"String" Value
invalid

decodeText :: forall a. JSON.FromJSON a => Text -> Either String a
decodeText :: forall a. FromJSON a => Text -> Either String a
decodeText = forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.ByteString.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8