nomyx-api (empty) → 0.1.0
raw patch · 8 files changed
+319/−0 lines, 8 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, containers, either, hslogger, lens, mtl, network-uri, nomyx-core, nomyx-language, resourcet, safe, servant, servant-client, servant-server, servant-swagger, split, stm, swagger2, text, transformers, wai, wai-cors, wai-extra, warp, yaml
Files
- LICENSE +27/−0
- Setup.hs +2/−0
- nomyx-api.cabal +52/−0
- src/Nomyx/Api/Api.hs +114/−0
- src/Nomyx/Api/Model/Error.hs +25/−0
- src/Nomyx/Api/Model/NewPlayer.hs +23/−0
- src/Nomyx/Api/Model/Player.hs +25/−0
- src/Nomyx/Api/Server.hs +51/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2012, Corentin Dupont. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author 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 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ nomyx-api.cabal view
@@ -0,0 +1,52 @@+name: nomyx-api +version: 0.1.0+synopsis: REST API for Nomyx+description: Please see README.md+homepage: http://www.nomyx.net+license: BSD3 +license-file: LICENSE+author: Corentin Dupont+maintainer: corentin.dupont@gmail.com+copyright: 2015 Corentin Dupont+category: Game+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Nomyx.Api.Model.Error+ , Nomyx.Api.Model.Player+ , Nomyx.Api.Model.NewPlayer+ , Nomyx.Api.Api+ , Nomyx.Api.Server+ ghc-options: -Wall+ build-depends: base >= 4.6 && < 5+ , aeson+ , text+ , split+ , containers+ , network-uri+ , QuickCheck+ , servant+ , servant-client+ , servant-server+ , servant-swagger+ , wai+ , wai-cors+ , swagger2+ , nomyx-language+ , nomyx-core+ , warp+ , yaml+ , bytestring+ , stm == 2.4.*+ , mtl >= 2.1 && < 2.3+ , either -any+ , lens -any+ , transformers+ , resourcet+ , wai-extra+ , safe+ , hslogger+ default-language: Haskell2010+
+ src/Nomyx/Api/Api.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++module Nomyx.Api.Api+ where++import GHC.Generics+import Data.Proxy+import Data.Yaml+import qualified Data.ByteString.Char8 as B+import Data.Maybe (fromMaybe)+import Data.List (intercalate)+import Data.Maybe+import Data.Typeable+import qualified Data.Text as T+import Data.Swagger+import Data.Swagger.Schema+import Servant.API+import Servant.Client+import Servant+import Network.URI (URI (..), URIAuth (..), parseURI)+import Network.Wai.Parse+import Nomyx.Api.Model.Player+import Nomyx.Api.Model.Error+import Nomyx.Api.Model.NewPlayer+import Nomyx.Core.Session hiding (getModules)+import Nomyx.Core.Types+import Nomyx.Core.Profile+import Nomyx.Language.Types+import Control.Concurrent.STM+import Control.Monad.State+import Control.Monad.Trans.Either+import Control.Monad.Except+import System.Log.Logger+import Test.QuickCheck++-- * API definition++type NomyxApi = PlayerApi :<|> RuleTemplateApi++type PlayerApi = "players" :> Get '[JSON] [ProfileData] + :<|> "players" :> ReqBody '[JSON] PlayerSettings :> Post '[JSON] ProfileData + :<|> "players" :> Capture "id" Int :> Get '[JSON] ProfileData+ :<|> "players" :> Capture "id" Int :> Delete '[JSON] ()+++type RuleTemplateApi = "templates" :> BasicAuth "foo-realm" PlayerNumber :> Get '[JSON] Library -- get all templates+ :<|> "templates" :> BasicAuth "foo-realm" PlayerNumber :> ReqBody '[JSON] Library :> Put '[JSON] () -- replace all templates++nomyxApi :: Proxy NomyxApi+nomyxApi = Proxy++serverPath :: String+serverPath = "https://api.nomyx.net/v1"++server :: TVar Session -> Server NomyxApi+server tv = ((playersGet tv) :<|> (playersPost tv) :<|> (playerGet tv) :<|> (playerDelete tv))+ :<|> ((templatesGet tv) :<|> (templatesPut tv))++-- * Players API++playersGet :: TVar Session -> ExceptT ServantErr IO [ProfileData]+playersGet tv = do+ s <- liftIO $ atomically $ readTVar tv+ pds <- liftIO $ getAllProfiles s+ return pds++playersPost :: TVar Session -> PlayerSettings -> ExceptT ServantErr IO ProfileData+playersPost tv ps = do+ liftIO $ updateSession tv (newPlayer 2 ps)+ s <- liftIO $ atomically $ readTVar tv+ pds <- liftIO $ getAllProfiles s+ return $ head pds++playerGet :: TVar Session -> PlayerNumber -> ExceptT ServantErr IO ProfileData+playerGet tv pn = do+ s <- liftIO $ atomically $ readTVar tv+ mpd <- liftIO $ getProfile s pn+ case mpd of+ Just pd -> return pd+ Nothing -> throwError $ err410 { errBody = "Player does not exist." }++playerDelete :: TVar Session -> PlayerNumber -> ExceptT ServantErr IO ()+playerDelete tv pn = error "not supported"++-- * Templates API++templatesGet :: TVar Session -> PlayerNumber -> ExceptT ServantErr IO Library+templatesGet tv _ = do+ s <- liftIO $ atomically $ readTVar tv+ return $ _mLibrary $ _multi s++templatesPost :: TVar Session -> PlayerNumber -> RuleTemplate -> ExceptT ServantErr IO ()+templatesPost tv _ rt = do+ liftIO $ updateSession tv (newRuleTemplate 1 rt)+ return ()++templatesPut :: TVar Session -> PlayerNumber -> Library -> ExceptT ServantErr IO ()+templatesPut tv pn lib = liftIO $ do+ debug $ "templatesPut library: " ++ (show lib)+ updateSession tv (updateLibrary pn lib)+ return ()++debug, info :: (MonadIO m) => String -> m ()+debug s = liftIO $ debugM "Nomyx.Api.Api" s+info s = liftIO $ infoM "Nomyx.Api.Api" s
+ src/Nomyx/Api/Model/Error.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Nomyx.Api.Model.Error+ ( Error (..)+ ) where++import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics+import Test.QuickCheck+++data Error = Error+ { code :: Integer+ , message :: String+ , fields :: String+ } deriving (Show, Eq, Generic)++instance FromJSON Error+instance ToJSON Error+instance Arbitrary Error where+ arbitrary = Error <$> arbitrary <*> arbitrary <*> arbitrary
+ src/Nomyx/Api/Model/NewPlayer.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Nomyx.Api.Model.NewPlayer+ ( NewPlayer (..)+ ) where++import Data.Aeson+import GHC.Generics+import Test.QuickCheck+++data NewPlayer = NewPlayer+ { name :: String+ } deriving (Show, Eq, Generic)++instance FromJSON NewPlayer+instance ToJSON NewPlayer+instance Arbitrary NewPlayer where+ arbitrary = NewPlayer <$> arbitrary
+ src/Nomyx/Api/Model/Player.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Nomyx.Api.Model.Player+ ( Player (..)+ ) where++import Data.Aeson+import GHC.Generics+import Test.QuickCheck+import Nomyx.Api.Model.NewPlayer+++data Player = Player+ { name :: String+ , id_ :: Integer+ } deriving (Show, Eq, Generic)++instance FromJSON Player+instance ToJSON Player+--instance Arbitrary Player where+-- arbitrary = Player <$> arbitrary <*> arbitrary
+ src/Nomyx/Api/Server.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}++module Nomyx.Api.Server where++import Nomyx.Api.Api+import Nomyx.Core.Types+import Nomyx.Core.Profile+import Nomyx.Language.Types+import Servant+import Servant+import qualified Network.Wai.Handler.Warp as Warp+import Network.Wai.Middleware.Cors+import Network.Wai+import Control.Concurrent.STM+import Control.Monad+import Data.Monoid+import Data.Typeable+import Data.ByteString.Char8 hiding (putStrLn)+import GHC.Generics++serveApi :: TVar Session -> IO ()+serveApi tv = do+ putStrLn "Starting Api on http://localhost:8001/"+ Warp.run 8001 $ myCors $ serveWithContext nomyxApi (basicAuthServerContext tv) (server tv)++-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.+authCheck :: (TVar Session) -> BasicAuthCheck PlayerNumber+authCheck tv = BasicAuthCheck (authCheck' tv)++authCheck' :: (TVar Session) -> BasicAuthData -> IO (BasicAuthResult PlayerNumber)+authCheck' tv (BasicAuthData username password) = do+ s <- atomically $ readTVar tv+ mpn <- getPlayerNumber' (unpack username) s+ case mpn of+ Just pn -> return (Authorized pn)+ Nothing -> return Unauthorized++basicAuthServerContext :: TVar Session -> Context (BasicAuthCheck PlayerNumber ': '[])+basicAuthServerContext tv = (authCheck tv) :. EmptyContext+ +customPolicy :: CorsResourcePolicy+customPolicy = simpleCorsResourcePolicy { corsMethods = simpleMethods <> ["DELETE", "PUT"] }++myCors :: Middleware+myCors = cors (const $ Just customPolicy)++putSwaggerYaml :: IO ()+putSwaggerYaml = undefined --BL.putStrLn $ encode $ toSwagger nomyxApi