diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for antiope-athena + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Arbor Networks (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Alexey Raga nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# antiope-athena diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/antiope-athena.cabal b/antiope-athena.cabal new file mode 100644 --- /dev/null +++ b/antiope-athena.cabal @@ -0,0 +1,66 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 1f2e25e53eece55bff870faefa1ede3bdaa0f8637db39b08513199c3a928573c + +name: antiope-athena +version: 1.0.0 +description: Please see the README on Github at +category: Services +homepage: https://github.com/arbor/antiope#readme +bug-reports: https://github.com/arbor/antiope/issues +author: Tyler Durden +maintainer: mayhem@arbor.net +copyright: Arbor Networks +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/arbor/antiope + +library + hs-source-dirs: + src + default-extensions: BangPatterns GeneralizedNewtypeDeriving OverloadedStrings TupleSections + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -O2 -msse4.2 + build-depends: + amazonka + , amazonka-athena + , amazonka-core + , base >=4.7 && <5 + , lens + , resourcet + , text + exposed-modules: + Antiope.Athena + other-modules: + Paths_antiope_athena + default-language: Haskell2010 + +test-suite antiope-athena-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + default-extensions: BangPatterns GeneralizedNewtypeDeriving OverloadedStrings TupleSections + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -O2 -msse4.2 -threaded -rtsopts -with-rtsopts=-N + build-depends: + amazonka + , amazonka-athena + , amazonka-core + , antiope-athena + , base >=4.7 && <5 + , lens + , resourcet + , text + other-modules: + Paths_antiope_athena + default-language: Haskell2010 diff --git a/src/Antiope/Athena.hs b/src/Antiope/Athena.hs new file mode 100644 --- /dev/null +++ b/src/Antiope/Athena.hs @@ -0,0 +1,65 @@ +module Antiope.Athena + ( query + , queryExecutionSucceed + , module Network.AWS.Athena + )where + +import Control.Lens +import Control.Monad.Trans.AWS hiding (await, send) +import Control.Monad.Trans.Resource +import Data.Text (Text) +import Network.AWS (MonadAWS, await, send) +import Network.AWS.Athena +import Network.AWS.Waiter hiding (accept) + +query :: (MonadResource m, MonadAWS m) + => ResultConfiguration + -> QueryExecutionContext + -> Text + -> Text + -> m [Row] +query config context qstring clientRequestToken = do + resp <- send $ startQueryExecution qstring config + & sqeQueryExecutionContext ?~ context + & sqeClientRequestToken ?~ clientRequestToken + case resp ^. sqersQueryExecutionId of + Just qeid -> go qeid + Nothing -> return [] + where + go qeid = do + accept <- await queryExecutionFinished (getQueryExecution qeid) + case accept of + AcceptSuccess -> do + results <- send $ getQueryResults qeid + case view gqrrsResultSet results of + Just rs -> return $ view rsRows rs + Nothing -> return [] + AcceptRetry -> go qeid + _ -> return [] + +queryExecutionFinished :: Wait GetQueryExecution +queryExecutionFinished = Wait + { _waitName = "QueryFinished" + , _waitAttempts = 100 + , _waitDelay = 1 + , _waitAcceptors = + [ matchAll Succeeded AcceptSuccess status + , matchAll Failed AcceptFailure status + , matchAll Cancelled AcceptFailure status + , matchAll Queued AcceptRetry status + , matchAll Running AcceptRetry status + ] + } + where + status :: Fold (Rs GetQueryExecution) QueryExecutionState + status = gqersQueryExecution . _Just . qeStatus . _Just . qesState . _Just + +queryExecutionSucceed :: (MonadResource m, MonadAWS m) + => Text + -> m Bool +queryExecutionSucceed qeid = do + eq <- view gqersQueryExecution <$> send (getQueryExecution qeid) + case view qesState =<< (view qeStatus =<< eq) of + Just Succeeded -> return True + Just _ -> return False + Nothing -> return False diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"