Initial project

.github/workflows/ci.yml

@@ -0,0 +1,60 @@
+name: Binaries
+
+defaults:
+  run:
+    shell: bash
+
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+
+    strategy:
+      fail-fast: false
+      matrix:
+        ghc: ["9.8.1", "9.6.3", "9.4.8"]
+        os: [ubuntu-latest]
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: haskell/actions/setup@v2
+        id: setup-haskell
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: 3.10.2.1
+
+      - name: Configure project
+        run: |
+          cabal configure --enable-tests --enable-benchmarks
+          cabal build all --dry-run
+
+      - name: Cabal cache over S3
+        uses: action-works/cabal-cache-s3@v1
+        env:
+          AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
+          AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
+        with:
+          region: us-west-2
+          dist-dir: dist-newstyle
+          store-path: ${{ steps.setup-haskell.outputs.cabal-store }}
+          threads: 16
+          archive-uri: ${{ secrets.BINARY_CACHE_URI }}
+          skip: "${{ secrets.BINARY_CACHE_URI == '' }}"
+
+      - name: Cabal cache over HTTPS
+        uses: action-works/cabal-cache-s3@v1
+        with:
+          dist-dir: dist-newstyle
+          store-path: ${{ steps.setup-haskell.outputs.cabal-store }}
+          threads: 16
+          archive-uri: https://cache.haskellworks.io/archive
+
+      - name: Test
+        run: |
+          cabal test all --enable-tests --enable-benchmarks

app/App/AWS/Env.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module App.AWS.Env
+  ( awsLogger
+  , mkEnv
+  , newAwsLogger
+  , setEnvEndpoint
+  ) where
+
+import App.Show                     (tshow)
+import Control.Concurrent           (myThreadId)
+import Control.Lens                 ((.~), (%~))
+import Control.Monad                (when, forM_)
+import Data.ByteString              (ByteString)
+import Data.ByteString.Builder      (toLazyByteString)
+import Data.Function                ((&))
+import Data.Generics.Product.Any    (the)
+import Network.HTTP.Client          (HttpException (..), HttpExceptionContent (..))
+
+import qualified Amazonka                   as AWS
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Lazy       as L
+import qualified Data.ByteString.Lazy       as LBS
+import qualified Data.ByteString.Lazy.Char8 as LC8
+import qualified Data.Text.Encoding         as T
+import qualified App.Console                as CIO
+import qualified System.IO                  as IO
+
+setEnvEndpoint :: Maybe (ByteString, Int, Bool) -> IO AWS.Env -> IO AWS.Env
+setEnvEndpoint mHostEndpoint getEnv = do
+  env <- getEnv
+  case mHostEndpoint of
+    Just (host, port, ssl) ->
+      pure $ env
+        & the @"overrides" .~ \svc -> do
+            svc & the @"endpoint" %~ \mkEndpoint region -> do
+              mkEndpoint region
+                & the @"host" .~ host
+                & the @"port" .~ port
+                & the @"secure" .~ ssl
+    Nothing -> pure env
+
+mkEnv :: AWS.Region -> (AWS.LogLevel -> LBS.ByteString -> IO ()) -> IO AWS.Env
+mkEnv region lg = do
+  lgr <- newAwsLogger lg
+  discoveredEnv <- AWS.newEnv AWS.discover
+
+  pure discoveredEnv
+    { AWS.logger = lgr
+    , AWS.region = region
+    , AWS.retryCheck = retryPolicy 5
+    }
+
+newAwsLogger :: Monad m => (AWS.LogLevel -> LBS.ByteString -> IO ()) -> m AWS.Logger
+newAwsLogger lg = return $ \y b ->
+  let lazyMsg = toLazyByteString b
+  in case L.toStrict lazyMsg of
+      msg | BS.isInfixOf "404 Not Found" msg    -> lg AWS.Debug lazyMsg
+      msg | BS.isInfixOf "304 Not Modified" msg -> lg AWS.Debug lazyMsg
+      _                                         -> lg y lazyMsg
+
+retryPolicy :: Int -> Int -> AWS.HttpException -> Bool
+retryPolicy maxNum attempt ex = (attempt <= maxNum) && shouldRetry ex
+
+shouldRetry :: AWS.HttpException -> Bool
+shouldRetry ex = case ex of
+  HttpExceptionRequest _ ctx -> case ctx of
+    ResponseTimeout          -> True
+    ConnectionTimeout        -> True
+    ConnectionFailure _      -> True
+    InvalidChunkHeaders      -> True
+    ConnectionClosed         -> True
+    InternalException _      -> True
+    NoResponseDataReceived   -> True
+    ResponseBodyTooShort _ _ -> True
+    _                        -> False
+  _ -> False
+
+awsLogger :: Maybe AWS.LogLevel -> AWS.LogLevel -> LC8.ByteString -> IO ()
+awsLogger maybeConfigLogLevel msgLogLevel message =
+  forM_ maybeConfigLogLevel $ \configLogLevel ->
+    when (msgLogLevel <= configLogLevel) do
+      threadId <- myThreadId
+      CIO.hPutStrLn IO.stderr $ "[" <> tshow msgLogLevel <> "] [tid: " <> tshow threadId <> "]"  <> text
+  where text = T.decodeUtf8 $ LBS.toStrict message

app/App/Cli/Options.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module App.Cli.Options where
+
+import App.Options
+import Control.Applicative
+import Data.ByteString (ByteString)
+
+import qualified App.Cli.Types              as CLI
+import qualified Amazonka                   as AWS
+import qualified Amazonka.Data              as AWS
+import qualified Data.Text                  as T
+import qualified Options.Applicative        as OA
+
+opts :: OA.ParserInfo CLI.Cmd
+opts = OA.info (pCmds <**> OA.helper) $ mconcat
+  [ OA.fullDesc
+  , OA.header $ mconcat
+    [ "rds-data-codecs"
+    ]
+  ]
+
+pCmds :: OA.Parser CLI.Cmd
+pCmds =
+  asum
+    [ subParser "execute-statement"
+        $ OA.info (CLI.CmdOfExecuteStatementCmd <$> pExecuteStatementCmd)
+        $ OA.progDesc "Execute statement command."
+    , subParser "example"
+        $ OA.info (CLI.CmdOfExampleCmd <$> pExampleCmd)
+        $ OA.progDesc "Example command."
+    ]
+
+pExecuteStatementCmd :: OA.Parser CLI.ExecuteStatementCmd
+pExecuteStatementCmd =
+  CLI.ExecuteStatementCmd
+    <$> do  optional $ OA.option (OA.eitherReader (AWS.fromText . T.pack)) $ mconcat
+              [ OA.long "aws-log-level"
+              , OA.help "AWS Log Level.  One of (Error, Info, Debug, Trace)"
+              , OA.metavar "AWS_LOG_LEVEL"
+              ]
+    <*> do  OA.option (OA.auto <|> text) $ mconcat
+              [ OA.long "region"
+              , OA.metavar "AWS_REGION"
+              , OA.showDefault
+              , OA.value AWS.Oregon
+              , OA.help "The AWS region in which to operate"
+              ]
+    <*> do  optional parseEndpoint
+    <*> 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"
+              ]
+    <*> do  OA.strOption $ mconcat
+              [ OA.long "sql"
+              , OA.help "SQL query"
+              , OA.metavar "SQL"
+              ]
+
+pExampleCmd :: OA.Parser CLI.ExampleCmd
+pExampleCmd =
+  CLI.ExampleCmd
+    <$> do  optional $ OA.option (OA.eitherReader (AWS.fromText . T.pack)) $ mconcat
+              [ OA.long "aws-log-level"
+              , OA.help "AWS Log Level.  One of (Error, Info, Debug, Trace)"
+              , OA.metavar "AWS_LOG_LEVEL"
+              ]
+    <*> do  OA.option (OA.auto <|> text) $ mconcat
+              [ OA.long "region"
+              , OA.metavar "AWS_REGION"
+              , OA.showDefault
+              , OA.value AWS.Oregon
+              , OA.help "The AWS region in which to operate"
+              ]
+    <*> do  optional parseEndpoint
+    <*> 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"
+              ]
+
+parseEndpoint :: OA.Parser (ByteString, Int, Bool)
+parseEndpoint =
+  (,,)
+    <$> do  OA.option (OA.eitherReader (AWS.fromText . T.pack)) $ mconcat
+              [ OA.long "host-name-override"
+              , OA.help "Override the host name (default: s3.amazonaws.com)"
+              , OA.metavar "HOST_NAME"
+              ]
+    <*> do  OA.option OA.auto $ mconcat
+              [ OA.long "host-port-override"
+              , OA.help "Override the host port"
+              , OA.metavar "HOST_PORT"
+              ]
+    <*> do  OA.option OA.auto $ mconcat
+              [ OA.long "host-ssl-override"
+              , OA.help "Override the host SSL"
+              , OA.metavar "HOST_SSL"
+              ]

app/App/Cli/Run.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+
+module App.Cli.Run
+  ( runCmd
+  ) where
+
+import App.Cli.Run.Example
+import App.Cli.Run.ExecuteStatement
+
+import qualified App.Cli.Types as CLI
+
+runCmd :: CLI.Cmd -> IO ()
+runCmd = \case
+  CLI.CmdOfExecuteStatementCmd cmd ->
+    runExecuteStatementCmd cmd
+  CLI.CmdOfBatchExecuteStatementCmd cmd ->
+    runBatchExecuteStatementCmd cmd
+  CLI.CmdOfExampleCmd cmd ->
+    runExampleCmd cmd
+
+runBatchExecuteStatementCmd :: CLI.BatchExecuteStatementCmd -> IO ()
+runBatchExecuteStatementCmd _ = pure ()

app/App/Cli/Run/BatchExecuteStatement.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
+
+module App.Cli.Run.BatchExecuteStatement
+  ( runBatchExecuteStatementCmd
+  ) where
+
+import qualified App.Cli.Types as CLI
+
+runBatchExecuteStatementCmd :: CLI.BatchExecuteStatementCmd -> IO ()
+runBatchExecuteStatementCmd _ = pure ()