aws-dynamodb-conduit (empty) → 0.1.0.0
raw patch · 6 files changed
+198/−0 lines, 6 filesdep +aesondep +attoparsec-transdep +awssetup-changed
Dependencies added: aeson, attoparsec-trans, aws, base, bytestring, conduit, http-conduit, http-types, json-togo, resourcet, text, transformers
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- aws-dynamodb-conduit.cabal +38/−0
- src/Aws/DynamoDb/Commands/Query/Conduit.hs +116/−0
- src/Aws/DynamoDb/Conduit.hs +7/−0
- src/Aws/DynamoDb/Core/Conduit.hs +15/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Sam Rijs++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aws-dynamodb-conduit.cabal view
@@ -0,0 +1,38 @@+-- Initial aws-dynamodb-query.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: aws-dynamodb-conduit+version: 0.1.0.0+synopsis: Conduit-based interface for AWS DynamoDB+-- description: +homepage: https://github.com/srijs/haskell-aws-dynamodb-query+license: MIT+license-file: LICENSE+author: Sam Rijs+maintainer: srijs@airpost.net+-- copyright: +category: AWS+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Aws.DynamoDb.Conduit+ Aws.DynamoDb.Core.Conduit+ Aws.DynamoDb.Commands.Query.Conduit+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <5.0,+ transformers >=0.3 && <0.5,+ bytestring >=0.10 && <0.11,+ text >=1.2 && <1.3,+ resourcet >=1.1 && <1.2,+ conduit >=1.2 && <1.3,+ http-conduit >=2.1 && <2.2,+ http-types >=0.8 && <0.9,+ aws >=0.12 && <0.13,+ aeson >=0.9 && <0.10,+ json-togo >=0.1.0.1 && <0.2,+ attoparsec-trans >=0.1.0.3 && <0.2+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Aws/DynamoDb/Commands/Query/Conduit.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, OverloadedStrings, RecordWildCards #-}++module Aws.DynamoDb.Commands.Query.Conduit+ ( module Aws.DynamoDb.Commands.Query+ , ConduitQuery(..), ConduitQueryResponse+ ) where++import Data.Aeson (parseJSON)+import Data.Aeson.Types (parseMaybe)+import Data.ByteString (ByteString)+import Data.Conduit (ConduitM, fuse, yield, await, ResumableSource, unwrapResumable)+import Data.IORef (IORef)+import Data.JSON.ToGo.Parser+import Data.Maybe (maybeToList, fromMaybe)+import Data.Monoid (Monoid, mempty, mappend, (<>), Last(..))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++import Control.Applicative ((<$), (<$>), (<*>))+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Parser (ParserT, runParserT, runParserTWith, eitherResultM, ResultM(..))+import Control.Monad.Trans.Resource (ResourceT, register, runResourceT, throwM)+import Control.Monad.Trans.Writer.Lazy (WriterT, tell, runWriterT)++import qualified Network.HTTP.Types as HTTP+import qualified Network.HTTP.Conduit as HTTP++import Aws.Core+import Aws.DynamoDb.Core hiding (runParser)+import Aws.DynamoDb.Core.Conduit+import Aws.DynamoDb.Commands.Query++data ConduitQuery = ConduitQuery { getQuery :: Query }++instance SignQuery ConduitQuery where+ type ServiceConfiguration ConduitQuery = DdbConfiguration+ signQuery = ddbSignQuery "Query" . getQuery++data IncompleteQueryResponse = IncompleteQueryResponse+ { incompleteLastKey :: Last [Attribute]+ , incompleteCount :: Last Int+ , incompleteScanned :: Last Int+ , incompleteConsumed :: Last ConsumedCapacity+ }++toQueryResponse :: IncompleteQueryResponse -> Maybe (QueryResponse)+toQueryResponse icr = do+ let items = mempty+ lastKey = getLast $ incompleteLastKey icr+ consumed = getLast $ incompleteConsumed icr+ count <- getLast $ incompleteCount icr+ scanned <- getLast $ incompleteScanned icr+ return $ QueryResponse items lastKey count scanned consumed++instance Monoid IncompleteQueryResponse where+ mempty = IncompleteQueryResponse mempty mempty mempty mempty+ mappend (IncompleteQueryResponse a b c d)+ (IncompleteQueryResponse e f g h)+ = IncompleteQueryResponse (a <> e) (b <> f) (c <> g) (d <> h)++responseParser :: Monad m => ParserM (WriterT [Item] m) QueryResponse+responseParser = pobject key >>= maybe (fail "incomplete") return . toQueryResponse+ where + key "Count" = setCount <$> Just <$> parse+ key "ScannedCount" = setScanned <$> Just <$> parse+ key "ConsumedCapacity" = setConsumed <$> Just <$> parse+ key "LastKey" = setLastKey <$> parseMaybe parseAttributeJson <$> pvalue+ key "Items" = mempty <$ (parray . const $ parse >>= lift . tell . maybeToList)+ setCount c = mempty { incompleteCount = Last c }+ setScanned c = mempty { incompleteScanned = Last c }+ setConsumed c = mempty { incompleteConsumed = Last c }+ setLastKey c = mempty { incompleteLastKey = Last c }++runParser :: (Monad m, Monoid i, Eq i) => ParserT i (WriterT a m) r -> ConduitM i a m r+runParser p = await' >>= lift . runWriterT . runParserT p >>= \w -> case w of+ (PartialM p', a) -> yield a >> runParser p'+ (FailM i s, a) -> yield a >> fail s+ (DoneM i r, a) -> yield a >> return r+ where await' = await >>= maybe (return mempty) (\i -> if i == mempty then await' else return i)++consume p rsrc = do+ src <- lift $ do+ (src, finalize) <- unwrapResumable rsrc+ register (runResourceT finalize)+ return src+ fuse src $ runParser p++instance Transaction ConduitQuery ConduitQueryResponse++type ConduitQueryResponse = ConduitResponse [Item] QueryResponse++instance ResponseConsumer ConduitQuery ConduitQueryResponse where+ type ResponseMetadata ConduitQueryResponse = DdbResponse+ responseConsumer _ ref resp = do+ tellMeta+ return $ case statusCode of+ 200 -> rSuccess+ _ -> rError+ where+ header = fmap T.decodeUtf8 . flip lookup (HTTP.responseHeaders resp)+ amzId = header "x-amzn-RequestId"+ amzCrc = header "x-amz-crc32"+ meta = DdbResponse amzCrc amzId+ tellMeta = liftIO $ tellMetadataRef ref meta++ rSuccess = consume responseParser $ HTTP.responseBody resp++ rError = do+ err'' <- consume parse $ HTTP.responseBody resp+ errCode <- readErrCode . T.drop 1 . snd . T.breakOn "#" $ aeType err''+ throwM . DdbError statusCode errCode . fromMaybe "" $ aeMessage err''++ readErrCode = return . read . T.unpack++ HTTP.Status{..} = HTTP.responseStatus resp
+ src/Aws/DynamoDb/Conduit.hs view
@@ -0,0 +1,7 @@+module Aws.DynamoDb.Conduit+ ( module Aws.DynamoDb.Core.Conduit+ , module Aws.DynamoDb.Commands.Conduit+ ) where++import Aws.DynamoDb.Commands.Conduit+import Aws.DynamoDb.Core.Conduit
+ src/Aws/DynamoDb/Core/Conduit.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, OverloadedStrings #-}++module Aws.DynamoDb.Core.Conduit+ ( ConduitResponse+ ) where++import Data.Conduit (ConduitM)++import Control.Monad.Trans.Resource (ResourceT)++import Aws.Core+import Aws.DynamoDb.Core+import Aws.DynamoDb.Commands.Query++type ConduitResponse a r = ConduitM () a (ResourceT IO) r