diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Timo von Holtz + +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 the nor the names of its + 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 +HOLDER 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/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/haxl-amazonka.cabal b/haxl-amazonka.cabal new file mode 100644 --- /dev/null +++ b/haxl-amazonka.cabal @@ -0,0 +1,25 @@ +name: haxl-amazonka +version: 0.1.0.0 +synopsis: Simple project template from stack +description: Please see README.md +homepage: http://github.com/tvh/haxl-amazonka#readme +license: BSD3 +license-file: LICENSE +author: Timo von Holtz +maintainer: tvh@tvholtz.de +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: lib + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , haxl >= 0.3 + , amazonka >= 1.3 + , amazonka-core >= 1.3 + , async + , transformers + , hashable + , conduit + exposed-modules: Network.AWS.DataSource diff --git a/lib/Network/AWS/DataSource.hs b/lib/Network/AWS/DataSource.hs new file mode 100644 --- /dev/null +++ b/lib/Network/AWS/DataSource.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall #-} +module Network.AWS.DataSource ( + AWSReq(..), + initGlobalState, + fetchAWS, + uncachedFetchAWS, + fetchAllAWS, + uncachedFetchAllAWS, + fetchAWSIn, + uncachedFetchAWSIn, + fetchAllAWSIn, + uncachedFetchAllAWSIn, +) where + +import Control.Concurrent.Async +import Control.Exception as E +import Control.Monad +import Control.Monad.IO.Class +import Data.Conduit +import Data.Conduit.List +import Data.Hashable +import Data.Maybe +import Data.Typeable +import Haxl.Core as Haxl +import Network.AWS as AWS + +data AWSReq res where + AWSReq + :: ( AWSRequest req + , Show req + , Typeable req + , Eq req + ) + => Maybe Region -> req -> AWSReq (Rs req) + AWSReqAll + :: ( AWSPager req + , Show req + , Typeable req + , Eq req + ) + => Maybe Region -> req -> AWSReq [Rs req] + +deriving instance Show (AWSReq res) + +instance Eq (AWSReq res) where + r1 == r2 = case (r1, r2) of + (AWSReq reg1 r1', AWSReq reg2 r2') -> (reg1==reg2) && typedEQ r1' r2' + (AWSReqAll reg1 r1', AWSReqAll reg2 r2') -> (reg1==reg2) && typedEQ r1' r2' + _ -> False + where + typedEQ r1' r2' = + let m_eq = do + r2'' <- cast r2' + Just $ r1' == r2'' + in fromMaybe False m_eq + +instance Hashable (AWSReq res) where + hashWithSalt salt (AWSReq reg req) = hashWithSalt salt (0::Int, reg, show req, typeOf req) + hashWithSalt salt (AWSReqAll reg req) = hashWithSalt salt (1::Int, reg, show req, typeOf req) + +instance DataSourceName AWSReq where + dataSourceName _ = "AWS" + +instance Show1 AWSReq where + show1 = show + +instance StateKey AWSReq where + data State AWSReq = AWSState AWS.Env + +instance DataSource u AWSReq where + fetch (AWSState aws_env) _ _ blocked_fetches = AsyncFetch $ \inner -> do + reqs <- forM blocked_fetches $ \(BlockedFetch aws_req result) -> + async $ do + res <- E.try $ runResourceT $ runAWS aws_env $ case aws_req of + AWSReq Nothing req -> send req + AWSReq (Just reg) req -> within reg $ send req + AWSReqAll Nothing req -> paginate req $$ consume + AWSReqAll (Just reg) req -> within reg $ paginate req $$ consume + liftIO $ putResult result res + forM_ (reqs :: [Async ()]) link + inner + forM_ reqs wait + +-- | Construct a global state to use in Haxl. +initGlobalState :: AWS.Env -> State AWSReq +initGlobalState aws_env = AWSState aws_env + +-- | Sends an 'AWSRequest'. +-- +-- The result will be cached. This should only be used for read-only access. +fetchAWS + :: ( AWSRequest a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq (Rs a) + ) + => a -> GenHaxl u (Rs a) +fetchAWS req = dataFetch (AWSReq Nothing req) + +-- | Sends an 'AWSRequest' in a specific region. +-- +-- The result will be cached. This should only be used for read-only access. +fetchAWSIn + :: ( AWSRequest a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq (Rs a) + ) + => Region -> a -> GenHaxl u (Rs a) +fetchAWSIn region req = dataFetch (AWSReq (Just region) req) + +-- | Uncached version of 'fetchAWS' +uncachedFetchAWS + :: ( AWSRequest a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq (Rs a) + ) + => a -> GenHaxl u (Rs a) +uncachedFetchAWS req = uncachedRequest (AWSReq Nothing req) + +-- | Uncached version of 'fetchAWSIn' +uncachedFetchAWSIn + :: ( AWSRequest a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq (Rs a) + ) + => Region -> a -> GenHaxl u (Rs a) +uncachedFetchAWSIn region req = uncachedRequest (AWSReq (Just region) req) + +-- | Sends requests necessary to fetch all result pages of a 'AWSRequest' +-- +-- The result will be cached. This should only be used for read-only access. +fetchAllAWS + :: ( AWSPager a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq [Rs a] + ) + => a -> GenHaxl u [Rs a] +fetchAllAWS req = dataFetch (AWSReqAll Nothing req) + +-- | Sends requests necessary to fetch all result pages of a 'AWSRequest' +-- in a specific region. +-- +-- The result will be cached. This should only be used for read-only access. +fetchAllAWSIn + :: ( AWSPager a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq [Rs a] + ) + => Region -> a -> GenHaxl u [Rs a] +fetchAllAWSIn region req = dataFetch (AWSReqAll (Just region) req) + +-- | Uncached version of 'fetchAllAWS' +uncachedFetchAllAWS + :: ( AWSPager a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq [Rs a] + ) + => a -> GenHaxl u [Rs a] +uncachedFetchAllAWS req = uncachedRequest (AWSReqAll Nothing req) + +-- | Uncached version of 'fetchAllAWSIn' +uncachedFetchAllAWSIn + :: ( AWSPager a + , Show a + , Typeable a + , Eq a + , Haxl.Request AWSReq [Rs a] + ) + => Region -> a -> GenHaxl u [Rs a] +uncachedFetchAllAWSIn region req = uncachedRequest (AWSReqAll (Just region) req)