├── Setup.hs ├── .gitignore ├── s └── bench ├── bench.lua ├── src ├── GraphQLHelpers.hs ├── GraphQL │ └── Schema.hs ├── NumberDataSource.hs ├── StarWarsData.hs ├── DropboxDataSource.hs ├── StarWarsModel.hs ├── GraphQL.hs ├── StarWarsDataSource.hs └── Main.hs ├── stack.yaml ├── datagraph.cabal ├── README.md ├── populate-redis.py └── LICENSE /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | /.cabal-sandbox/ 3 | /.stack-work/ 4 | cabal.sandbox.config 5 | -------------------------------------------------------------------------------- /s/bench: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | cd $(cd "$(dirname "$0")"; pwd)/.. 3 | 4 | wrk -s bench.lua http://localhost:8080/graphql 5 | -------------------------------------------------------------------------------- /bench.lua: -------------------------------------------------------------------------------- 1 | wrk.scheme = "http" 2 | wrk.port = 8080 3 | wrk.path = "/graphql" 4 | wrk.method = "POST" 5 | wrk.body = "query HeroNameQuery { newhope_hero: hero(episode: NEWHOPE) { name } empire_hero: hero(episode: EMPIRE) { name } jedi_hero: hero(episode: JEDI) { name } } query EpisodeQuery { episode(id: NEWHOPE) { name releaseYear } }" 6 | wrk.headers["Content-Type"] = "application/json" 7 | -------------------------------------------------------------------------------- /src/GraphQLHelpers.hs: -------------------------------------------------------------------------------- 1 | module GraphQLHelpers where 2 | 3 | import Data.Text (Text) 4 | import GraphQL 5 | 6 | class KnownValue v where 7 | encodeKnownValue :: v -> ResolvedValue 8 | 9 | instance KnownValue Text where 10 | encodeKnownValue = RScalar . SString 11 | 12 | instance KnownValue Int where 13 | encodeKnownValue = RScalar . SInt . fromInteger . toInteger 14 | 15 | knownValue :: KnownValue v => v -> ValueResolver 16 | -- TODO: assert _args is empty 17 | knownValue v _args = return $ encodeKnownValue v 18 | 19 | class GraphQLID id where 20 | fetchByID :: id -> GraphQLHandler ResolvedValue 21 | 22 | idResolver :: GraphQLID id => id -> ValueResolver 23 | -- TODO: assert _args is empty 24 | idResolver i _args = fetchByID i 25 | 26 | listResolver :: GraphQLID id => [id] -> ValueResolver 27 | listResolver elementIDs _args = do 28 | -- TODO: assert _args is empty 29 | return $ RList $ fmap idResolver elementIDs 30 | 31 | class GraphQLObject a where 32 | resolveObject :: a -> ObjectResolver 33 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-4.2 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: ["graphql-0.3"] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 1.0.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | -------------------------------------------------------------------------------- /src/GraphQL/Schema.hs: -------------------------------------------------------------------------------- 1 | {- 2 | type Name = Text 3 | 4 | -- GraphQL schema 5 | data SchemaType 6 | = TString 7 | | TInt 8 | | TFloat 9 | | TBoolean 10 | | TID 11 | | TObject (HashMap Name SchemaType) 12 | | TEnum {- ... -} 13 | | TInterface {- ... -} 14 | | TUnion {- ... -} 15 | | TList SchemaType 16 | | TNonNull SchemaType 17 | -} 18 | 19 | {- 20 | enum DogCommand { SIT, DOWN, HEEL } 21 | 22 | type Dog implements Pet { 23 | name: String! 24 | nickname: String 25 | barkVolume: Int 26 | doesKnowCommand(dogCommand: DogCommand!): Boolean! 27 | isHousetrained(atOtherHomes: Boolean): Boolean! 28 | owner: Human 29 | } 30 | 31 | interface Sentient { 32 | name: String! 33 | } 34 | 35 | interface Pet { 36 | name: String! 37 | } 38 | 39 | type Alien implements Sentient { 40 | name: String! 41 | homePlanet: String 42 | } 43 | 44 | type Human implements Sentient { 45 | name: String! 46 | } 47 | 48 | enum CatCommand { JUMP } 49 | 50 | type Cat implements Pet { 51 | name: String! 52 | nickname: String 53 | doesKnowCommand(catCommand: CatCommand!): Boolean! 54 | meowVolume: Int 55 | } 56 | 57 | union CatOrDog = Cat | Dog 58 | union DogOrHuman = Dog | Human 59 | union HumanOrAlien = Human | Alien 60 | 61 | type QueryRoot { 62 | dog: Dog 63 | } 64 | -} 65 | -------------------------------------------------------------------------------- /datagraph.cabal: -------------------------------------------------------------------------------- 1 | -- Initial datagraph.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: datagraph 5 | version: 0.1.0.0 6 | synopsis: GraphQL data access router 7 | -- description: 8 | license: Apache-2.0 9 | license-file: LICENSE 10 | author: Chad Austin 11 | maintainer: chad@chadaustin.me 12 | copyright: Copyright (c) 2016 Dropbox, Inc. 13 | category: Database 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | executable datagraph 19 | main-is: Main.hs 20 | ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N 21 | build-depends: base >=4.8 && <4.9 22 | , graphql 23 | , wai 24 | , haxl 25 | , http-types 26 | , warp 27 | , aeson 28 | , aeson-pretty 29 | , text 30 | , attoparsec 31 | , unordered-containers 32 | , bytestring 33 | , HTF 34 | , hashable 35 | , hedis 36 | , transformers 37 | hs-source-dirs: src 38 | default-language: Haskell2010 39 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DataGraph 2 | 3 | An experimental project to explore what a GraphQL server with optimal IO concurrency and batching would look like. 4 | 5 | # Resources 6 | 7 | ## Haxl 8 | 9 | - Useful Haxl tutorial: http://gelisam.blogspot.com/2015/01/haxl-anti-tutorial.html 10 | - How to write a data source: https://gist.github.com/gelisam/0549eb2a292f86ca2574/4ef520bd40e2d9a2b660e0fb7f4baddabcaa0eed 11 | - Another Haxl tutorial: https://simonmar.github.io/posts/2015-10-20-Fun-With-Haxl-1.html 12 | - Example Data Source: https://github.com/simonmar/haskell-eXchange-2015/blob/3ae0e34a051201eb77721bee2e940ec1f764a0df/BlogDataSource.hs 13 | - Haxl.Prelude: https://hackage.haskell.org/package/haxl-0.3.1.0/docs/Haxl-Prelude.html 14 | - Haxl.Core: https://hackage.haskell.org/package/haxl-0.3.1.0/docs/Haxl-Core.html 15 | 16 | ## GraphQL 17 | 18 | - The GraphQL spec: https://facebook.github.io/graphql/ 19 | - Star Wars schema stuff: https://github.com/graphql/graphql-js/tree/master/src/__tests__ 20 | 21 | # WORKING 22 | 23 | - queries 24 | - redis backend 25 | - backend IO batching 26 | - benchmarks 27 | - mutations, incl. sequencing 28 | 29 | # TODO 30 | 31 | - nullability 32 | - input coercion 33 | - eliminate as much haxl / graphql boilerplate as possible 34 | - errors (overall envelope: {data: {: }, errors: [...]} 35 | - query tests from https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js 36 | - type checking 37 | -------------------------------------------------------------------------------- /src/NumberDataSource.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving, GADTs, TypeFamilies, MultiParamTypeClasses, GeneralizedNewtypeDeriving, OverloadedStrings #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | 4 | module NumberDataSource where 5 | 6 | import Data.Hashable 7 | import Haxl.Core 8 | import Data.IORef 9 | import Control.Monad (forM_) 10 | import Text.Printf 11 | import GraphQLHelpers 12 | import qualified Data.HashMap.Strict as HashMap 13 | 14 | data NumberRequest a where 15 | AddToNumber :: Int -> NumberRequest () 16 | FetchCurrentNumber :: NumberRequest NumberObject 17 | 18 | deriving instance Eq (NumberRequest a) 19 | deriving instance Show (NumberRequest a) 20 | 21 | instance Hashable (NumberRequest a) where 22 | hashWithSalt salt (AddToNumber i) = hashWithSalt salt (0 :: Int, i) 23 | hashWithSalt salt (FetchCurrentNumber) = hashWithSalt salt (1 :: Int) 24 | 25 | data NumberObject = NumberObject 26 | { theNumber :: Int 27 | } 28 | deriving (Show) 29 | 30 | instance GraphQLObject NumberObject where 31 | resolveObject (NumberObject v) = HashMap.fromList 32 | [ ("theNumber", knownValue v) 33 | ] 34 | 35 | instance StateKey NumberRequest where 36 | data State NumberRequest = NumberRequestState (IORef Int) 37 | 38 | runNumberRequest :: IORef Int -> NumberRequest a -> ResultVar a -> IO () 39 | runNumberRequest numberRef (AddToNumber i) var = do 40 | modifyIORef numberRef (+ i) 41 | putSuccess var () 42 | runNumberRequest numberRef FetchCurrentNumber var = do 43 | NumberObject <$> readIORef numberRef >>= putSuccess var 44 | 45 | instance DataSourceName NumberRequest where 46 | dataSourceName _ = "NumberRequestDataSource" 47 | 48 | instance Show1 NumberRequest where 49 | show1 (AddToNumber i) = printf "AddToNumber(%i)" i 50 | show1 (FetchCurrentNumber) = "FetchCurrentNumber" 51 | 52 | instance DataSource () NumberRequest where 53 | fetch (NumberRequestState numberRef) _ _ reqs = SyncFetch $ do 54 | putStrLn $ "do some number requests: " ++ show [show1 req | BlockedFetch req _ <- reqs] 55 | forM_ reqs $ \(BlockedFetch req var) -> do 56 | runNumberRequest numberRef req var 57 | 58 | initializeNumberDataSource :: Int -> IO (State NumberRequest) 59 | initializeNumberDataSource i = NumberRequestState <$> newIORef i 60 | -------------------------------------------------------------------------------- /populate-redis.py: -------------------------------------------------------------------------------- 1 | import redis 2 | import json 3 | 4 | NewHope, Empire, Jedi = range(4, 7) 5 | 6 | starWarsCharacters = { 7 | "1000": { 8 | "name": "Luke Skywalker", 9 | "friends": [ "1002", "1003", "2000", "2001" ], 10 | "appearsIn": [ NewHope, Empire, Jedi ], 11 | "homePlanet": "Tatooine", 12 | }, 13 | "1001": { 14 | "name": "Darth Vader", 15 | "friends": [ "1004" ], 16 | "appearsIn": [ NewHope, Empire, Jedi ], 17 | "homePlanet": "Tatooine", 18 | }, 19 | "1002": { 20 | "name": "Han Solo", 21 | "friends": [ "1000", "1003", "2001" ], 22 | "appearsIn": [ NewHope, Empire, Jedi ], 23 | "homePlanet": "Corellia", 24 | }, 25 | "1003": { 26 | "name": "Leia Organa", 27 | "friends": [ "1000", "1002", "2000", "2001" ], 28 | "appearsIn": [ NewHope, Empire, Jedi ], 29 | "homePlanet": "Alderaan", 30 | }, 31 | "1004": { 32 | "name": "Wilhuff Tarkin", 33 | "friends": [ "1001" ], 34 | "appearsIn": [ NewHope ], 35 | "homePlanet": None, 36 | }, 37 | "2000": { 38 | "name": "C-3PO", 39 | "friends": [ "1000", "1002", "1003", "2001" ], 40 | "appearsIn": [ NewHope, Empire, Jedi ], 41 | "primaryFunction": "Protocol", 42 | }, 43 | "2001": { 44 | "name": "R2-D2", 45 | "friends": [ "1000", "1002", "1003" ], 46 | "appearsIn": [ NewHope, Empire, Jedi ], 47 | "primaryFunction": "Astromech", 48 | }, 49 | } 50 | 51 | starWarsEpisodes = { 52 | NewHope: { 53 | "name": "Star Wars Episode IV: A New Hope", 54 | "releaseYear": 1977, 55 | "hero": "2001", 56 | }, 57 | Empire: { 58 | "name": "Star Wars Episode V: The Empire Strikes Back", 59 | "releaseYear": 1980, 60 | "hero": "1000", 61 | }, 62 | Jedi: { 63 | "name": "Star Wars Episode VI: Return of the Jedi", 64 | "releaseYear": 1983, 65 | "hero": "2001", 66 | }, 67 | } 68 | 69 | r = redis.StrictRedis(host='localhost', port=6379, db=0) 70 | 71 | for characterID, character in starWarsCharacters.items(): 72 | r.set("CHARACTER:" + characterID, json.dumps(character)) 73 | 74 | for episodeID, episode in starWarsEpisodes.items(): 75 | r.set("EPISODE:" + str(episodeID), json.dumps(episode)) 76 | -------------------------------------------------------------------------------- /src/StarWarsData.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module StarWarsData where 4 | 5 | import Data.HashMap.Strict (HashMap) 6 | import qualified Data.HashMap.Strict as HashMap 7 | import StarWarsModel 8 | 9 | starWarsCharacters :: HashMap CharacterID Character 10 | starWarsCharacters = HashMap.fromList 11 | [ ("1000", Character 12 | { cName = "Luke Skywalker" 13 | , cFriends = [ "1002", "1003", "2000", "2001" ] 14 | , cAppearsIn = [ NewHope, Empire, Jedi ] 15 | , cType = Human $ Just "Tatooine" 16 | }) 17 | , ("1001", Character 18 | { cName = "Darth Vader" 19 | , cFriends = [ "1004" ] 20 | , cAppearsIn = [ NewHope, Empire, Jedi ] 21 | , cType = Human $ Just "Tatooine" 22 | }) 23 | , ("1002", Character 24 | { cName = "Han Solo" 25 | , cFriends = [ "1000", "1003", "2001" ] 26 | , cAppearsIn = [ NewHope, Empire, Jedi ] 27 | , cType = Human $ Just "Corellia" 28 | }) 29 | , ("1003", Character 30 | { cName = "Leia Organa" 31 | , cFriends = [ "1000", "1002", "2000", "2001" ] 32 | , cAppearsIn = [ NewHope, Empire, Jedi ] 33 | , cType = Human $ Just "Alderaan" 34 | }) 35 | , ("1004", Character 36 | { cName = "Wilhuff Tarkin" 37 | , cFriends = [ "1001" ] 38 | , cAppearsIn = [ NewHope ] 39 | , cType = Human Nothing 40 | }) 41 | , ("2000", Character 42 | { cName = "C-3PO" 43 | , cFriends = [ "1000", "1002", "1003", "2001" ] 44 | , cAppearsIn = [ NewHope, Empire, Jedi ] 45 | , cType = Droid "Protocol" 46 | }) 47 | , ("2001", Character 48 | { cName = "R2-D2" 49 | , cFriends = [ "1000", "1002", "1003" ] 50 | , cAppearsIn = [ NewHope, Empire, Jedi ] 51 | , cType = Droid "Astromech" 52 | }) 53 | ] 54 | 55 | starWarsEpisodes :: HashMap EpisodeID Episode 56 | starWarsEpisodes = HashMap.fromList 57 | [ (NewHope, Episode 58 | { eName = "Star Wars Episode IV: A New Hope" 59 | , eReleaseYear = 1977 60 | , eHero = "2001" 61 | }) 62 | , (Empire, Episode 63 | { eName = "Star Wars Episode V: The Empire Strikes Back" 64 | , eReleaseYear = 1980 65 | , eHero = "1000" 66 | }) 67 | , (Jedi, Episode 68 | { eName = "Star Wars Episode VI: Return of the Jedi" 69 | , eReleaseYear = 1983 70 | , eHero = "2001" 71 | }) 72 | ] 73 | -------------------------------------------------------------------------------- /src/DropboxDataSource.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving, GADTs, TypeFamilies, MultiParamTypeClasses, GeneralizedNewtypeDeriving, OverloadedStrings #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | 4 | module DropboxDataSource where 5 | 6 | import Data.Text (Text) 7 | import Data.String (IsString) 8 | import Data.Typeable (Typeable) 9 | import Data.Hashable 10 | import qualified Data.HashMap.Strict as HashMap 11 | import Haxl.Core 12 | import Text.Printf 13 | import qualified Data.Text as Text 14 | import Control.Monad (forM_) 15 | import GraphQL 16 | import GraphQLHelpers 17 | 18 | newtype UserID = UserID Text 19 | deriving (Show, Eq, Hashable, IsString) 20 | 21 | instance GraphQLArgument UserID where 22 | decodeInputArgument (IScalar (SString cid)) = Right $ UserID cid 23 | decodeInputArgument _ = Left $ "invalid Character ID" 24 | 25 | 26 | data User = User { userName :: Text } 27 | deriving (Show) 28 | 29 | data UserRequest a where 30 | FetchUser :: UserID -> UserRequest User 31 | deriving Typeable 32 | 33 | -- This function is necessary to resolve the GADT properly. Otherwise you get insane errors like 34 | -- 'b0' is untouchable: https://ghc.haskell.org/trac/ghc/ticket/9223 35 | runUserRequest :: UserRequest a -> ResultVar a -> IO () 36 | runUserRequest (FetchUser userId) var = do 37 | if userId == "10" then 38 | putSuccess var $ User "FRIEND!!" 39 | else 40 | putSuccess var $ User "ME!!" 41 | 42 | deriving instance Show (UserRequest a) 43 | deriving instance Eq (UserRequest a) 44 | 45 | instance DataSourceName UserRequest where 46 | dataSourceName _ = "UserRequestDataSource" 47 | 48 | instance Show1 UserRequest where 49 | show1 (FetchUser (UserID userID)) = printf "FetchUser(%s)" (Text.unpack userID) 50 | 51 | instance Hashable (UserRequest a) where 52 | hashWithSalt salt (FetchUser userId) = hashWithSalt salt (0 :: Int, userId) 53 | 54 | instance StateKey UserRequest where 55 | data State UserRequest = UserRequestState 56 | 57 | instance DataSource () UserRequest where 58 | fetch _ _ _ reqs = SyncFetch $ do 59 | putStrLn $ "do some requests: " ++ show (length reqs) 60 | forM_ reqs $ \(BlockedFetch req var) -> do 61 | runUserRequest req var 62 | 63 | instance GraphQLObject User where 64 | resolveObject (User name) = HashMap.fromList 65 | [ ("name", knownValue name) 66 | ] 67 | 68 | instance GraphQLID UserID where 69 | fetchByID userID = do 70 | user <- dataFetch (FetchUser userID) 71 | return $ RObject $ resolveObject user 72 | -------------------------------------------------------------------------------- /src/StarWarsModel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, LambdaCase, RecordWildCards #-} 2 | 3 | module StarWarsModel where 4 | 5 | import qualified Data.Text as Text 6 | import Data.Text (Text) 7 | import Data.Hashable (Hashable(..)) 8 | import Data.String (IsString) 9 | import GraphQL 10 | import Data.Aeson (FromJSON(..), Value(..), (.:)) 11 | import Control.Applicative ((<|>)) 12 | 13 | -- Episode ID 14 | 15 | data EpisodeID = NewHope | Empire | Jedi 16 | deriving (Eq, Show) 17 | 18 | instance FromJSON EpisodeID where 19 | parseJSON (Number 4) = return NewHope 20 | parseJSON (Number 5) = return Empire 21 | parseJSON (Number 6) = return Jedi 22 | parseJSON _ = fail "Unknown EpisodeID" 23 | 24 | instance GraphQLArgument EpisodeID where 25 | decodeInputArgument (IScalar (SEnum episode)) = case episode of 26 | "NEWHOPE" -> return NewHope 27 | "EMPIRE" -> return Empire 28 | "JEDI" -> return Jedi 29 | _ -> Left $ "Unknown episode enum: " ++ Text.unpack episode 30 | decodeInputArgument _ = Left $ "invalid episode ID" 31 | 32 | instance Hashable EpisodeID where 33 | hashWithSalt salt NewHope = hashWithSalt salt (0 :: Int) 34 | hashWithSalt salt Empire = hashWithSalt salt (1 :: Int) 35 | hashWithSalt salt Jedi = hashWithSalt salt (2 :: Int) 36 | 37 | -- Episode 38 | 39 | data Episode = Episode 40 | { eName :: Text 41 | , eReleaseYear :: Int 42 | , eHero :: CharacterID 43 | } 44 | deriving (Eq, Show) 45 | 46 | instance FromJSON Episode where 47 | parseJSON (Object o) = do 48 | eName <- o .: "name" 49 | eReleaseYear <- o .: "releaseYear" 50 | eHero <- o .: "hero" 51 | return Episode{..} 52 | parseJSON _ = fail "Episode must be an Object" 53 | 54 | -- CharacterID 55 | 56 | newtype CharacterID = CharacterID Text 57 | deriving (Eq, Show, Hashable, IsString, FromJSON) 58 | 59 | instance GraphQLArgument CharacterID where 60 | decodeInputArgument (IScalar (SString cid)) = Right $ CharacterID cid 61 | decodeInputArgument _ = Left $ "invalid Character ID" 62 | 63 | -- Character 64 | 65 | data CharacterType 66 | = Human {- home planet -} (Maybe Text) 67 | | Droid {- primary function -} Text 68 | deriving (Eq, Show) 69 | 70 | data Character = Character 71 | { cName :: Text 72 | , cFriends :: [CharacterID] 73 | , cAppearsIn :: [EpisodeID] 74 | , cType :: CharacterType 75 | } 76 | deriving (Eq, Show) 77 | 78 | instance FromJSON Character where 79 | parseJSON (Object o) = do 80 | cName <- o .: "name" 81 | cFriends <- o .: "friends" 82 | cAppearsIn <- o .: "appearsIn" 83 | cType <- (Human <$> o .: "homePlanet") <|> (Droid <$> o .: "primaryFunction") 84 | return Character{..} 85 | parseJSON _ = fail "Character must be an Object" 86 | -------------------------------------------------------------------------------- /src/GraphQL.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module GraphQL where 4 | 5 | import Data.Int (Int32) 6 | import Data.Text (Text) 7 | import qualified Data.Aeson as JSON 8 | import Data.HashMap.Strict (HashMap) 9 | import qualified Data.Text as Text 10 | import qualified Data.HashMap.Strict as HashMap 11 | import Haxl.Core (GenHaxl) 12 | 13 | data Scalar 14 | = SInt Int32 15 | | SFloat Double 16 | | SBoolean Bool 17 | | SString Text 18 | | SEnum Text -- unquoted on parse 19 | deriving (Show) 20 | 21 | instance JSON.ToJSON Scalar where 22 | toJSON (SInt i) = JSON.toJSON i 23 | toJSON (SFloat f) = JSON.toJSON f 24 | toJSON (SBoolean b) = JSON.toJSON b 25 | toJSON (SString s) = JSON.toJSON s 26 | toJSON (SEnum t) = JSON.toJSON t 27 | 28 | data InputValue 29 | = IVar Text 30 | | IScalar Scalar 31 | | IList [InputValue] 32 | | IObject (HashMap Text InputValue) 33 | deriving (Show) 34 | 35 | class GraphQLArgument a where 36 | decodeInputArgument :: InputValue -> Either String a 37 | 38 | instance GraphQLArgument Int where 39 | decodeInputArgument (IScalar (SInt i)) = Right $ fromInteger $ toInteger i 40 | decodeInputArgument _ = Left "invalid integer" 41 | 42 | type ResolverArguments = HashMap Text InputValue 43 | 44 | requireArgument :: (Monad m, GraphQLArgument a) => ResolverArguments -> Text -> m a 45 | requireArgument args argName = do 46 | lookupArgument args argName >>= \case 47 | Just x -> return x 48 | Nothing -> fail $ "Required argument missing: " ++ Text.unpack argName 49 | 50 | lookupArgument :: (Monad m, GraphQLArgument a) => ResolverArguments -> Text -> m (Maybe a) 51 | lookupArgument args argName = do 52 | case HashMap.lookup argName args of 53 | Just x -> case decodeInputArgument x of 54 | Right y -> return $ Just y 55 | Left err -> fail $ "Error decoding argument " ++ Text.unpack argName ++ ": " ++ err 56 | Nothing -> return Nothing 57 | 58 | type GraphQLHandler a = GenHaxl () a 59 | 60 | data ResolvedValue 61 | = RNull 62 | | RScalar Scalar 63 | | RList [ValueResolver] 64 | | RObject ObjectResolver 65 | type ValueResolver = ResolverArguments -> GraphQLHandler ResolvedValue 66 | 67 | data FullyResolvedValue 68 | = FNull 69 | | FScalar Scalar 70 | | FList [FullyResolvedValue] 71 | | FObject (HashMap Text FullyResolvedValue) 72 | 73 | instance JSON.ToJSON FullyResolvedValue where 74 | toJSON FNull = JSON.Null 75 | toJSON (FScalar s) = JSON.toJSON s 76 | toJSON (FList l) = JSON.toJSON l 77 | toJSON (FObject o) = JSON.toJSON o 78 | 79 | type ObjectResolver = HashMap Text ValueResolver 80 | 81 | 82 | 83 | -- TODO: actually use this 84 | {- 85 | class GraphQLEnum a where 86 | enumName :: Proxy a -> Text 87 | enumDescription :: Proxy a -> Maybe Text 88 | enumValues :: Proxy a -> [a] 89 | renderValue :: a -> Text 90 | renderDescription :: a -> Text 91 | -- TODO: deprecation 92 | -} 93 | -------------------------------------------------------------------------------- /src/StarWarsDataSource.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving, GADTs, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, LambdaCase, RecordWildCards #-} 2 | {-# OPTIONS_GHC -fno-warn-orphans #-} 3 | 4 | module StarWarsDataSource where 5 | 6 | import Data.Hashable (Hashable(..)) 7 | import Text.Printf 8 | import qualified Data.Text as Text 9 | import qualified Data.Text.Encoding as Text 10 | import qualified Data.HashMap.Strict as HashMap 11 | import Haxl.Core 12 | import Control.Monad (void, forM) 13 | import Database.Redis 14 | import Data.ByteString (ByteString) 15 | import Data.Aeson as JSON 16 | import Data.ByteString.Lazy (fromStrict) 17 | import Data.Monoid 18 | import GraphQL 19 | import GraphQLHelpers 20 | 21 | import StarWarsModel 22 | --import StarWarsData 23 | 24 | data StarWarsRequest a where 25 | FetchCharacter :: CharacterID -> StarWarsRequest Character 26 | FetchEpisode :: EpisodeID -> StarWarsRequest Episode 27 | 28 | deriving instance Eq (StarWarsRequest a) 29 | deriving instance Show (StarWarsRequest a) 30 | 31 | -- Is there a way to make GHC automatically derive this? 32 | instance Hashable (StarWarsRequest a) where 33 | hashWithSalt salt (FetchCharacter userId) = hashWithSalt salt (0 :: Int, userId) 34 | hashWithSalt salt (FetchEpisode episodeId) = hashWithSalt salt (1 :: Int, episodeId) 35 | 36 | class RedisKey a where 37 | encodeRedisKey :: a -> ByteString 38 | 39 | instance RedisKey CharacterID where 40 | encodeRedisKey (CharacterID c) = "CHARACTER:" <> Text.encodeUtf8 c 41 | 42 | instance RedisKey EpisodeID where 43 | encodeRedisKey NewHope = "EPISODE:4" 44 | encodeRedisKey Empire = "EPISODE:5" 45 | encodeRedisKey Jedi= "EPISODE:6" 46 | 47 | readRedisValue :: (RedisKey k, FromJSON v) => k -> Redis (Maybe v) 48 | readRedisValue k = do 49 | get (encodeRedisKey k) >>= \case 50 | Right (Just bs) -> return $ JSON.decode $ fromStrict bs 51 | _ -> return Nothing 52 | 53 | runStarWarsRequest :: StarWarsRequest a -> ResultVar a -> Redis (IO ()) 54 | runStarWarsRequest (FetchCharacter characterID) var = do 55 | readRedisValue characterID >>= \case 56 | Just c -> do 57 | return $ putSuccess var c 58 | Nothing -> do 59 | return $ putFailure var $ userError "No such character or failed to decode" 60 | runStarWarsRequest (FetchEpisode episodeID) var = do 61 | readRedisValue episodeID >>= \case 62 | Just e -> do 63 | return $ putSuccess var e 64 | Nothing -> do 65 | return $ putFailure var $ userError "No such episode or failed to decode" 66 | 67 | {- 68 | case HashMap.lookup characterID starWarsCharacters of 69 | Just c -> do 70 | putSuccess var c 71 | Nothing -> do 72 | putFailure var $ userError "No such character" 73 | 74 | case HashMap.lookup episodeID starWarsEpisodes of 75 | Just e -> do 76 | putSuccess var e 77 | Nothing -> do 78 | putFailure var $ userError $ "No such episode: " ++ show episodeID 79 | -} 80 | 81 | instance DataSourceName StarWarsRequest where 82 | dataSourceName _ = "StarWarsRequest" 83 | 84 | instance StateKey StarWarsRequest where 85 | data State StarWarsRequest = StarWarsState Connection 86 | 87 | instance Show1 StarWarsRequest where 88 | show1 (FetchCharacter (CharacterID characterID)) = printf "FetchCharacter(%s)" (Text.unpack characterID) 89 | show1 (FetchEpisode episodeID) = printf "FetchEpisode(%s)" (show episodeID) 90 | 91 | instance DataSource () StarWarsRequest where 92 | fetch (StarWarsState conn) _ _ reqs = SyncFetch $ do 93 | putStrLn $ "fetch star wars batch of size " ++ show (length reqs) ++ ": " ++ show [show1 req | BlockedFetch req _var <- reqs] 94 | actions <- runRedis conn $ do 95 | forM reqs $ \(BlockedFetch req var) -> do 96 | runStarWarsRequest req var 97 | void $ sequence actions 98 | 99 | openStarWarsRedisConnection :: IO (State StarWarsRequest) 100 | openStarWarsRedisConnection = do 101 | putStrLn "Connecting to Redis" 102 | conn <- connect defaultConnectInfo 103 | return $ StarWarsState conn 104 | 105 | instance GraphQLID CharacterID where 106 | fetchByID characterID = do 107 | character <- dataFetch (FetchCharacter characterID) 108 | return $ RObject $ resolveObject character 109 | 110 | instance GraphQLID EpisodeID where 111 | fetchByID episodeID = do 112 | episode <- dataFetch (FetchEpisode episodeID) 113 | return $ RObject $ resolveObject episode 114 | 115 | instance GraphQLObject Character where 116 | resolveObject Character{..} = HashMap.fromList 117 | [ ("name", knownValue cName) 118 | , ("friends", listResolver cFriends) 119 | , ("appearsIn", listResolver cAppearsIn) 120 | ] 121 | 122 | instance GraphQLObject Episode where 123 | resolveObject Episode{..} = HashMap.fromList 124 | [ ("name", knownValue eName) 125 | , ("releaseYear", knownValue eReleaseYear) 126 | , ("hero", idResolver eHero) 127 | ] 128 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, LambdaCase, GADTs, StandaloneDeriving, FlexibleInstances #-} 2 | {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, InstanceSigs, GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE ScopedTypeVariables, RecordWildCards, PartialTypeSignatures #-} 4 | 5 | module Main (main) where 6 | 7 | --import Debug.Trace 8 | import Network.Wai 9 | import Network.HTTP.Types (status200) 10 | import Network.Wai.Handler.Warp (run) 11 | import Data.Text.Encoding (decodeUtf8) 12 | import Data.Attoparsec.Text (parseOnly, endOfInput) 13 | import qualified Data.Text as Text 14 | import Data.ByteString.Lazy (toStrict) 15 | import qualified Data.GraphQL.AST as AST 16 | import Data.GraphQL.Parser (document) 17 | import Data.HashMap.Strict (HashMap) 18 | import qualified Data.HashMap.Strict as HashMap 19 | import Haxl.Prelude 20 | import Haxl.Core 21 | import Data.Traversable (for) 22 | import qualified Data.Aeson.Encode.Pretty as JSON 23 | 24 | import GraphQL 25 | import GraphQLHelpers 26 | import DropboxDataSource 27 | import StarWarsModel 28 | import StarWarsDataSource 29 | import NumberDataSource 30 | 31 | decodeInputValue :: AST.Value -> InputValue 32 | decodeInputValue = \case 33 | AST.ValueVariable _ -> error "TODO: variable lookup in environment" 34 | AST.ValueInt i -> IScalar $ SInt i 35 | AST.ValueFloat f -> IScalar $ SFloat f 36 | AST.ValueBoolean f -> IScalar $ SBoolean f 37 | AST.ValueString (AST.StringValue s) -> IScalar $ SString s 38 | AST.ValueEnum s -> IScalar $ SEnum s 39 | AST.ValueList (AST.ListValue ls) -> IList $ fmap decodeInputValue ls 40 | AST.ValueObject (AST.ObjectValue fields) -> IObject $ 41 | HashMap.fromList [(name, decodeInputValue value) | AST.ObjectField name value <- fields] 42 | 43 | decodeArgument :: AST.Argument -> (Text, InputValue) 44 | decodeArgument (AST.Argument name value) = (name, decodeInputValue value) 45 | 46 | processSelectionSet :: ObjectResolver -> AST.SelectionSet -> GraphQLHandler (HashMap Text FullyResolvedValue) 47 | processSelectionSet objectResolver selectionSet = do 48 | fmap HashMap.fromList $ for selectionSet $ \case 49 | AST.SelectionField (AST.Field alias name arguments _directives innerSelectionSet) -> do 50 | -- traceShowM $ name 51 | valueResolver <- case HashMap.lookup name objectResolver of 52 | Just vr -> return vr 53 | Nothing -> fail $ "Requested unknown field: " ++ Text.unpack name 54 | 55 | let args = HashMap.fromList $ fmap decodeArgument arguments 56 | outputValue <- valueResolver args >>= \case 57 | RNull -> return FNull 58 | RScalar s -> return $ FScalar s 59 | RList ls -> do 60 | if null innerSelectionSet then do 61 | fail "TODO: lists without selection sets are unsupported" 62 | else do 63 | elements <- for ls $ \elementResolver -> do 64 | element <- elementResolver HashMap.empty >>= \case 65 | RObject elementObjectResolver -> do 66 | processSelectionSet elementObjectResolver innerSelectionSet 67 | _ -> do 68 | fail "Selecting fields from lists requires that all element values be lists" 69 | return (FObject element :: FullyResolvedValue) 70 | return (FList elements :: FullyResolvedValue) 71 | RObject o -> do 72 | if null innerSelectionSet then do 73 | fail "Must select fields out of object" 74 | else do 75 | FObject <$> processSelectionSet o innerSelectionSet 76 | return (if Text.null alias then name else alias, outputValue) 77 | _ -> fail "unsupported selection" 78 | 79 | meResolver :: ValueResolver 80 | meResolver = idResolver $ UserID "ME" 81 | 82 | friendResolver :: ValueResolver 83 | friendResolver args = do 84 | userID <- requireArgument args "id" 85 | fetchByID (userID :: UserID) 86 | 87 | heroResolver :: ValueResolver 88 | heroResolver args = do 89 | episodeID <- lookupArgument args "episode" >>= \case 90 | Just x -> return x 91 | Nothing -> return NewHope 92 | episode <- dataFetch $ FetchEpisode episodeID 93 | character <- dataFetch $ FetchCharacter $ eHero episode 94 | return $ RObject $ resolveObject character 95 | 96 | episodeResolver :: ValueResolver 97 | episodeResolver args = do 98 | episodeID <- requireArgument args "id" 99 | episode <- dataFetch $ FetchEpisode episodeID 100 | return $ RObject $ resolveObject episode 101 | 102 | addToNumberResolver :: ValueResolver 103 | addToNumberResolver args = do 104 | newNumber <- requireArgument args "newNumber" 105 | () <- uncachedRequest $ AddToNumber newNumber 106 | -- CAREFUL - the () <- above causes ghc to emit a >>= rather than >> which 107 | -- is important because >>= guarantees sequencing in haxl but >> runs 108 | -- both sides in parallel. Running in parallel here is a bad deal because 109 | -- the fetch needs to happen after the write. 110 | newNumberObject <- dataFetch FetchCurrentNumber 111 | return $ RObject $ resolveObject newNumberObject 112 | 113 | data Server = Server 114 | { rootQuery :: ObjectResolver 115 | , rootMutation :: ObjectResolver 116 | } 117 | 118 | data QueryBatch 119 | = QueryBatch [AST.Node] 120 | | SingleMutation AST.Node 121 | 122 | data AccumulationState = AccumulationState [AST.Node] [QueryBatch] 123 | 124 | flushQueries :: AccumulationState -> [QueryBatch] 125 | flushQueries (AccumulationState [] batches) = batches 126 | flushQueries (AccumulationState queries batches) = QueryBatch (reverse queries) : batches 127 | 128 | addDefinition :: AccumulationState -> AST.OperationDefinition -> AccumulationState 129 | addDefinition (AccumulationState queries batches) (AST.Query node) = 130 | AccumulationState (node : queries) batches 131 | addDefinition acc (AST.Mutation node) = 132 | AccumulationState [] (SingleMutation node : flushQueries acc) 133 | 134 | groupQueries :: [AST.OperationDefinition] -> [QueryBatch] 135 | groupQueries = reverse . flushQueries . foldl' addDefinition (AccumulationState [] []) 136 | 137 | handleRequest :: Server -> StateStore -> (Response -> IO b) -> AST.Document -> IO b 138 | handleRequest server stateStore respond doc = do 139 | let (AST.Document defns) = doc 140 | let operations = [op | AST.DefinitionOperation op <- defns] 141 | let groups = groupQueries operations 142 | 143 | outputs <- for groups $ \case 144 | QueryBatch queries -> do 145 | queryEnv <- initEnv stateStore () 146 | runHaxl queryEnv $ do 147 | for queries $ \(AST.Node name [] [] selectionSet) -> do 148 | output <- processSelectionSet (rootQuery server) selectionSet 149 | return (name, output) 150 | SingleMutation mutation -> do 151 | let (AST.Node name [] [] selectionSet) = mutation 152 | -- top-level mutations must be executed in order, and clear the cache 153 | -- in between 154 | maps <- for selectionSet $ \selection -> do 155 | mutationEnv <- initEnv stateStore () 156 | runHaxl mutationEnv $ do 157 | processSelectionSet (rootMutation server) [selection] 158 | return [(name, mconcat $ maps)] 159 | 160 | let response = HashMap.fromList [("data" :: Text, HashMap.fromList $ mconcat outputs )] 161 | respond $ responseLBS 162 | status200 163 | [("Content-Type", "application/json")] 164 | (JSON.encodePretty response) 165 | 166 | app :: StateStore -> Application 167 | app stateStore request respond = do 168 | -- TODO: check the request URL 169 | -- TODO: check the request method (require POST) 170 | 171 | _body <- fmap (decodeUtf8 . toStrict) $ strictRequestBody request 172 | 173 | let body' = Text.unlines 174 | [ "" 175 | , "query our_names { me { name }, friend(id: \"10\") { name } }" 176 | , "query HeroNameQuery { newhope_hero: hero(episode: NEWHOPE) { name } empire_hero: hero(episode: EMPIRE) { name } jedi_hero: hero(episode: JEDI) { name } }" 177 | , "query EpisodeQuery { episode(id: NEWHOPE) { name releaseYear } }" 178 | , "query newhope_hero_friends { episode(id: NEWHOPE) { hero { name, friends { name }, appearsIn { releaseYear } } } }" 179 | , "mutation numbers { first: addToNumber(newNumber: 1) { theNumber } second: addToNumber(newNumber: 2) { theNumber } third: addToNumber(newNumber: 3) { theNumber } }" 180 | ] 181 | 182 | queryDoc <- case parseOnly (document <* endOfInput) body' of 183 | Left err -> do 184 | fail $ "Error parsing query: " ++ err 185 | Right d -> do 186 | return d 187 | 188 | let rootQuery = HashMap.fromList 189 | [ ("me", meResolver) 190 | , ("friend", friendResolver) 191 | , ("hero", heroResolver) 192 | , ("episode", episodeResolver) 193 | ] 194 | let rootMutation = HashMap.fromList 195 | [ ("addToNumber", addToNumberResolver) 196 | ] 197 | 198 | let server = Server rootQuery rootMutation 199 | handleRequest server stateStore respond queryDoc 200 | 201 | main :: IO () 202 | main = do 203 | putStrLn $ "http://localhost:8080/" 204 | 205 | conn <- openStarWarsRedisConnection 206 | nds <- initializeNumberDataSource 0 207 | let stateStore = stateSet nds $ stateSet conn $ stateSet UserRequestState $ stateEmpty 208 | run 8080 $ app stateStore 209 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | --------------------------------------------------------------------------------