rds-data 0.0.0.4 → 0.0.0.5
raw patch · 13 files changed
+115/−125 lines, 13 files
Files
- app/App/Cli/Options.hs +16/−13
- app/App/Cli/Run/Down.hs +2/−42
- app/App/Cli/Run/Example.hs +2/−2
- app/App/Cli/Run/ExecuteStatement.hs +2/−2
- app/App/Cli/Run/LocalStack.hs +3/−3
- app/App/Cli/Run/Up.hs +2/−4
- app/App/Cli/Types.hs +20/−24
- integration/Test/Data/RdsData/Migration/ConnectionSpec.hs +1/−1
- polysemy/Data/RdsData/Polysemy/Core.hs +17/−16
- polysemy/Data/RdsData/Polysemy/Migration.hs +11/−6
- rds-data.cabal +1/−1
- src/Data/RdsData/Aws.hs +26/−5
- testlib/Data/RdsData/Polysemy/Test/Env.hs +12/−6
app/App/Cli/Options.hs view
@@ -10,6 +10,7 @@ import qualified Amazonka.Data as AWS import qualified App.Cli.Types as CLI+import Data.RdsData.Aws import qualified Data.Text as T import qualified Options.Applicative as OA @@ -35,9 +36,9 @@ $ OA.progDesc "Launch a local-stack RDS cluster." ] -pUpCmd :: OA.Parser CLI.UpCmd-pUpCmd =- CLI.UpCmd+pStatementContext :: OA.Parser StatementContext+pStatementContext =+ StatementContext <$> do OA.strOption $ mconcat [ OA.long "resource-arn" , OA.help "Resource ARN"@@ -48,6 +49,17 @@ , OA.help "Secret ARN" , OA.metavar "ARN" ]+ <*> do optional+ ( OA.strOption $ mconcat+ [ OA.long "database"+ , OA.help "Database"+ , OA.metavar "DATABASE"+ ]+ )+pUpCmd :: OA.Parser CLI.UpCmd+pUpCmd =+ CLI.UpCmd+ <$> pStatementContext <*> do OA.strOption $ mconcat [ OA.long "migration-file" , OA.help "Migration File"@@ -57,16 +69,7 @@ pDownCmd :: OA.Parser CLI.DownCmd pDownCmd = CLI.DownCmd- <$> do OA.strOption $ mconcat- [ OA.long "resource-arn"- , OA.help "Resource ARN"- , OA.metavar "ARN"- ]- <*> do OA.strOption $ mconcat- [ OA.long "secret-arn"- , OA.help "Secret ARN"- , OA.metavar "ARN"- ]+ <$> pStatementContext <*> do OA.strOption $ mconcat [ OA.long "migration-file" , OA.help "Migration File"
app/App/Cli/Run/Down.hs view
@@ -12,25 +12,17 @@ ( runDownCmd ) where -import Control.Monad.IO.Class import Data.Generics.Product.Any-import Data.Maybe-import Data.RdsData.Migration.Types (MigrationRow (..))-import Data.RdsData.Types import Lens.Micro import qualified Amazonka as AWS import qualified App.Cli.Types as CLI import qualified App.Console as T-import qualified Data.Aeson as J import Data.RdsData.Aws-import qualified Data.RdsData.Decode.Row as DEC import Data.RdsData.Polysemy.Core import Data.RdsData.Polysemy.Error import Data.RdsData.Polysemy.Migration import qualified Data.Text as T-import qualified Data.Text.Lazy.Encoding as LT-import qualified Data.Text.Lazy.IO as LT import HaskellWorks.Polysemy import HaskellWorks.Polysemy.Amazonka import HaskellWorks.Polysemy.File@@ -38,7 +30,6 @@ import HaskellWorks.Prelude import Polysemy.Log import Polysemy.Time.Interpreter.Ghc-import qualified System.IO as IO newtype AppError = AppError Text@@ -47,8 +38,7 @@ runApp :: () => CLI.DownCmd -> Sem- [ Reader AwsResourceArn- , Reader AwsSecretArn+ [ Reader StatementContext , Reader AWS.Env , Error AppError , DataLog AwsLogEntry@@ -61,8 +51,7 @@ ] () -> IO () runApp cmd f = f- & runReader (AwsResourceArn $ cmd ^. the @"resourceArn")- & runReader (AwsSecretArn $ cmd ^. the @"secretArn")+ & runReader (cmd ^. the @"statementContext") & runReaderAwsEnvDiscover & trap @AppError reportFatal & interpretDataLogAwsLogEntryToLog@@ -93,32 +82,3 @@ & trap @JsonDecodeError (throw . AppError . T.pack . show) & trap @RdsDataError (throw . AppError . T.pack . show) & trap @YamlDecodeError (throw . AppError . T.pack . show)-- id do- res <- executeStatement- ( mconcat- [ "SELECT"- , " uuid,"- , " created_at,"- , " deployed_by"- , "FROM migration"- ]- )- & trap @AWS.Error (throw . AppError . T.pack . show)- & trap @RdsDataError (throw . AppError . T.pack . show)-- liftIO . LT.putStrLn $ LT.decodeUtf8 $ J.encode res-- decodeMigrationRow <- pure $ id @(DEC.DecodeRow MigrationRow) $- MigrationRow- <$> DEC.ulid- <*> DEC.utcTime- <*> DEC.text-- records <- pure $ id @[[Value]] $ fromMaybe [] $ mapM (mapM fromField) =<< res ^. the @"records"-- row <- pure $ DEC.decodeRows decodeMigrationRow records-- liftIO $ IO.print row-- pure ()
app/App/Cli/Run/Example.hs view
@@ -74,8 +74,8 @@ let theAwsLogLevel = cmd ^. the @"mAwsLogLevel" let theMHostEndpoint = cmd ^. the @"mHostEndpoint" let theRegion = cmd ^. the @"region"- let theResourceArn = cmd ^. the @"resourceArn"- let theSecretArn = cmd ^. the @"secretArn"+ let theResourceArn = cmd ^. the @"statementContext" . the @"resourceArn" . the @1+ let theSecretArn = cmd ^. the @"statementContext" . the @"secretArn" . the @1 envAws <- liftIO (IO.unsafeInterleaveIO (mkEnv theRegion (awsLogger theAwsLogLevel)))
app/App/Cli/Run/ExecuteStatement.hs view
@@ -27,8 +27,8 @@ let theAwsLogLevel = cmd ^. the @"mAwsLogLevel" let theMHostEndpoint = cmd ^. the @"mHostEndpoint" let theRegion = cmd ^. the @"region"- let theResourceArn = cmd ^. the @"resourceArn"- let theSecretArn = cmd ^. the @"secretArn"+ let theResourceArn = cmd ^. the @"statementContext" . the @"resourceArn" . the @1+ let theSecretArn = cmd ^. the @"statementContext" . the @"secretArn" . the @1 let theSql = cmd ^. the @"sql" envAws <-
app/App/Cli/Run/LocalStack.hs view
@@ -26,6 +26,7 @@ import qualified Control.Monad.Trans.Resource.Internal as IO import Data.Acquire (ReleaseType (ReleaseNormal)) import Data.Generics.Product.Any+import Data.RdsData.Aws import Data.RdsData.Polysemy.Test.Cluster import Data.RdsData.Polysemy.Test.Env import GHC.IORef (IORef)@@ -113,15 +114,14 @@ void $ runLocalTestEnv (pure container) do rdsClusterDetails <- createRdsDbCluster "rds_data_migration" (pure container) - runReaderResourceAndSecretArnsFromResponses rdsClusterDetails do+ runReaderStatementContextFromClusterDetails rdsClusterDetails do lsEp <- getLocalStackEndpoint container jotShow_ lsEp -- Localstack endpoint let port = lsEp ^. the @"port" let exampleCmd = "awslocal --endpoint-url=http://localhost:" <> show port <> " s3 ls" -- Example awslocal command: jot_ exampleCmd- jotShowM_ $ ask @AwsResourceArn- jotShowM_ $ ask @AwsSecretArn+ jotShowM_ $ ask @StatementContext pure () failure -- Not a failure
app/App/Cli/Run/Up.hs view
@@ -36,8 +36,7 @@ runApp :: () => CLI.UpCmd -> Sem- [ Reader AwsResourceArn- , Reader AwsSecretArn+ [ Reader StatementContext , Reader AWS.Env , Error AppError , DataLog AwsLogEntry@@ -50,8 +49,7 @@ ] () -> IO () runApp cmd f = f- & runReader (AwsResourceArn $ cmd ^. the @"resourceArn")- & runReader (AwsSecretArn $ cmd ^. the @"secretArn")+ & runReader (cmd ^. the @"statementContext") & runReaderAwsEnvDiscover & trap @AppError reportFatal & interpretDataLogAwsLogEntryToLog
app/App/Cli/Types.hs view
@@ -20,6 +20,7 @@ import qualified Amazonka as AWS import qualified Amazonka.RDSData as AWS+import Data.RdsData.Aws data Cmd = CmdOfBatchExecuteStatementCmd BatchExecuteStatementCmd@@ -30,42 +31,37 @@ | CmdOfUpCmd UpCmd data ExecuteStatementCmd = ExecuteStatementCmd- { mAwsLogLevel :: Maybe AWS.LogLevel- , region :: AWS.Region- , mHostEndpoint :: Maybe (ByteString, Int, Bool)- , resourceArn :: Text- , secretArn :: Text- , sql :: Text+ { mAwsLogLevel :: Maybe AWS.LogLevel+ , region :: AWS.Region+ , mHostEndpoint :: Maybe (ByteString, Int, Bool)+ , statementContext :: StatementContext+ , sql :: Text } deriving Generic data BatchExecuteStatementCmd = BatchExecuteStatementCmd- { mAwsLogLevel :: Maybe AWS.LogLevel- , region :: AWS.Region- , mHostEndpoint :: Maybe (ByteString, Int, Bool)- , parameterSets :: Maybe [[AWS.SqlParameter]]- , resourceArn :: Text- , secretArn :: Text- , sql :: Text+ { mAwsLogLevel :: Maybe AWS.LogLevel+ , region :: AWS.Region+ , mHostEndpoint :: Maybe (ByteString, Int, Bool)+ , parameterSets :: Maybe [[AWS.SqlParameter]]+ , statementContext :: StatementContext+ , sql :: Text } deriving Generic data ExampleCmd = ExampleCmd- { mAwsLogLevel :: Maybe AWS.LogLevel- , region :: AWS.Region- , mHostEndpoint :: Maybe (ByteString, Int, Bool)- , resourceArn :: Text- , secretArn :: Text+ { mAwsLogLevel :: Maybe AWS.LogLevel+ , region :: AWS.Region+ , mHostEndpoint :: Maybe (ByteString, Int, Bool)+ , statementContext :: StatementContext } deriving Generic data UpCmd = UpCmd- { resourceArn :: Text- , secretArn :: Text- , migrationFp :: FilePath+ { statementContext :: StatementContext+ , migrationFp :: FilePath } deriving Generic data DownCmd = DownCmd- { resourceArn :: Text- , secretArn :: Text- , migrationFp :: FilePath+ { statementContext :: StatementContext+ , migrationFp :: FilePath } deriving Generic data LocalStackCmd = LocalStackCmd
integration/Test/Data/RdsData/Migration/ConnectionSpec.hs view
@@ -44,7 +44,7 @@ dbClusterArn <- rdsClusterDetails ^. the @"createDbClusterResponse" . the @"dbCluster" . _Just . the @"dbClusterArn" & nothingFail - runReaderResourceAndSecretArnsFromResponses rdsClusterDetails $ do+ runReaderStatementContextFromClusterDetails rdsClusterDetails $ do waitUntilRdsDbClusterAvailable dbClusterArn & trapFail @AWS.Error & jotShowDataLog @AwsLogEntry
polysemy/Data/RdsData/Polysemy/Core.hs view
@@ -26,34 +26,37 @@ import Lens.Micro newExecuteStatement :: ()- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Text -> Sem r AWS.ExecuteStatement newExecuteStatement sql = do- AwsResourceArn theResourceArn <- ask- AwsSecretArn theSecretArn <- ask+ context <- ask @StatementContext + let AwsResourceArn theResourceArn = context ^. the @"resourceArn"+ let AwsSecretArn theSecretArn = context ^. the @"secretArn"+ pure $ AWS.newExecuteStatement theResourceArn theSecretArn sql+ & the @"database" .~ (context ^? the @"database" . _Just . the @1) newBatchExecuteStatement :: ()- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Text -> Sem r AWS.BatchExecuteStatement newBatchExecuteStatement sql = do- AwsResourceArn theResourceArn <- ask- AwsSecretArn theSecretArn <- ask+ context <- ask @StatementContext + let AwsResourceArn theResourceArn = context ^. the @"resourceArn"+ let AwsSecretArn theSecretArn = context ^. the @"secretArn"+ pure $ AWS.newBatchExecuteStatement theResourceArn theSecretArn sql+ & the @"database" .~ (context ^? the @"database" . _Just . the @1) executeStatement :: () => Member (DataLog AwsLogEntry) r => Member (Embed m) r => Member (Error AWS.Error) r => Member (Error RdsDataError) r- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Member (Reader Env) r => Member Log r => Member Resource r@@ -74,8 +77,7 @@ => Member (Embed m) r => Member (Error AWS.Error) r => Member (Error RdsDataError) r- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Member (Reader Env) r => Member Log r => Member Resource r@@ -89,8 +91,7 @@ => Member (Embed m) r => Member (Error AWS.Error) r => Member (Error RdsDataError) r- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Member (Reader Env) r => Member Log r => Member Resource r@@ -108,7 +109,7 @@ ] executeStatement_- "CREATE INDEX idx_migration_created_at ON migration (created_at);"+ "CREATE INDEX IF NOT EXISTS idx_migration_created_at ON migration (created_at);" executeStatement_- "CREATE INDEX idx_migration_deployed_by ON migration (deployed_by);"+ "CREATE INDEX IF NOT EXISTS idx_migration_deployed_by ON migration (deployed_by);"
polysemy/Data/RdsData/Polysemy/Migration.hs view
@@ -11,11 +11,14 @@ import qualified Amazonka.Env as AWS import qualified Amazonka.Types as AWS+import qualified Data.Aeson as J+import qualified Data.ByteString.Lazy as LBS import Data.Generics.Product.Any import Data.RdsData.Aws import Data.RdsData.Migration.Types hiding (id) import Data.RdsData.Polysemy.Core import Data.RdsData.Polysemy.Error+import qualified Data.Text.Encoding as T import HaskellWorks.Polysemy import HaskellWorks.Polysemy.Amazonka import HaskellWorks.Polysemy.File@@ -31,8 +34,7 @@ => Member (Error RdsDataError) r => Member (Error YamlDecodeError) r => Member (Reader AWS.Env) r- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Member Log r => Member Resource r => FilePath@@ -45,8 +47,10 @@ forM_ statements $ \statement -> do info $ "Executing statement: " <> tshow statement - executeStatement (statement ^. the @1)+ response <- executeStatement (statement ^. the @1) + info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))+ migrateUp :: () => Member (DataLog AwsLogEntry) r => Member (Embed IO) r@@ -56,8 +60,7 @@ => Member (Error RdsDataError) r => Member (Error YamlDecodeError) r => Member (Reader AWS.Env) r- => Member (Reader AwsResourceArn) r- => Member (Reader AwsSecretArn) r+ => Member (Reader StatementContext) r => Member Log r => Member Resource r => FilePath@@ -70,4 +73,6 @@ forM_ statements $ \statement -> do info $ "Executing statement: " <> tshow statement - executeStatement (statement ^. the @1)+ response <- executeStatement (statement ^. the @1)++ info $ "Results: " <> T.decodeUtf8 (LBS.toStrict (J.encode (response ^. the @"records")))
rds-data.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.6 name: rds-data-version: 0.0.0.4+version: 0.0.0.5 synopsis: Codecs for use with AWS rds-data description: Codecs for use with AWS rds-data. category: Data
src/Data/RdsData/Aws.hs view
@@ -1,12 +1,33 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Data.RdsData.Aws- ( AwsResourceArn(..),- AwsSecretArn(..),+ ( AwsResourceArn(AwsResourceArn),+ AwsSecretArn(AwsSecretArn),+ Database(Database),+ StatementContext(StatementContext),+ newStatementContext, ) where -import Data.Text (Text)+import Data.String (IsString)+import Data.Text (Text)+import GHC.Generics newtype AwsResourceArn = AwsResourceArn Text- deriving (Eq, Show)+ deriving (Eq, Generic, IsString, Show) newtype AwsSecretArn = AwsSecretArn Text- deriving (Eq, Show)+ deriving (Eq, Generic, IsString, Show)++newtype Database = Database Text+ deriving (Eq, Generic, IsString, Show)++data StatementContext = StatementContext+ { resourceArn :: AwsResourceArn+ , secretArn :: AwsSecretArn+ , database :: Maybe Database+ } deriving (Eq, Generic, Show)++newStatementContext :: AwsResourceArn -> AwsSecretArn -> StatementContext+newStatementContext theResourceArn theSecretArn =+ StatementContext theResourceArn theSecretArn Nothing
testlib/Data/RdsData/Polysemy/Test/Env.hs view
@@ -17,7 +17,7 @@ runLocalTestEnv, runTestEnv, runReaderFromEnvOrFail,- runReaderResourceAndSecretArnsFromResponses,+ runReaderStatementContextFromClusterDetails, ) where import qualified Amazonka as AWS@@ -81,17 +81,23 @@ runReader (f env) action -runReaderResourceAndSecretArnsFromResponses :: ()+runReaderStatementContextFromClusterDetails :: () => Member Hedgehog r => RdsClusterDetails- -> Sem (Reader AwsResourceArn : Reader AwsSecretArn : r) a+ -> Sem (Reader StatementContext : r) a -> Sem r a-runReaderResourceAndSecretArnsFromResponses details f = do+runReaderStatementContextFromClusterDetails details f = do resourceArn <- (details ^. the @"createDbClusterResponse" . the @"dbCluster" . _Just . the @"dbClusterArn") & nothingFail secretArn <- (details ^. the @"createSecretResponse" ^. the @"arn") & nothingFail - f & runReader (AwsResourceArn resourceArn)- & runReader (AwsSecretArn secretArn)+ mDatabase <- pure $ (details ^? the @"createDbClusterResponse" . the @"dbCluster" . _Just . the @"databaseName" . _Just)+ <&> Database++ statementContext <- pure $ newStatementContext (AwsResourceArn resourceArn) (AwsSecretArn secretArn)+ & the @"database" .~ mDatabase+++ f & runReader statementContext