hunt-server 0.3.0.1 → 0.3.0.2

raw patch · 2 files changed

+128/−1 lines, 2 files

Files

• hunt-server.cabal +2/−1
• src/Hunt/Server/Schrotty.hs +126/−0

@@ -1,5 +1,5 @@ name:          hunt-server-version:       0.3.0.1+version:       0.3.0.2 license:       MIT license-file:  LICENSE author:        Chris Reumann, Ulf Sauer, Sebastian Philipp@@ -31,6 +31,7 @@   other-modules:                 Hunt.Server                 Hunt.Server.Common+                Hunt.Server.Schrotty                 Hunt.Server.Template    build-depends:   base                   >= 4         && < 5

@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs             #-}++-- ----------------------------------------------------------------------------+{- |+  Schrotty server.+  Scotty with custom error handling.+  All regular scotty functions can be used.+-}+-- ----------------------------------------------------------------------------++module Hunt.Server.Schrotty+(+  -- * Start the server+  schrotty+, schrottyOpts++  -- * Adjusted/Added Scotty Functions+, jsonData+, param+, jsonPretty++  -- * Types+, module Web.Scotty.Trans+, ActionSchrotty+, ActionSchrottyT+, WebError(..)+)+where++import           Network.HTTP.Types+import           Network.Wai.Handler.Warp   (Port)++import           Web.Scotty.Trans           hiding (jsonData, param)+import qualified Web.Scotty.Trans           as Scotty++import           Data.Text.Lazy             (Text)+import qualified Data.Text.Lazy             as TL++import           Data.Aeson                 as A+import           Data.Aeson.Encode.Pretty   as AP++import           Hunt.Interpreter.Command   (CmdError (..))+import           Hunt.Server.Common++-- ------------------------------------------------------------++type ActionSchrottyT m a = ActionT WebError m a++type ActionSchrotty a    = ActionT WebError IO a++data WebError+  = InterpreterError CmdError+  | NotFound+  | JsonInvalid      String+  | MissingParam     Text+  | Other            Text+  | Text             Int Text+  | forall a . ToJSON a =>+    Json             Int a+-- XXX: no Show instance because it's not a Haskell98 type++instance ScottyError WebError where+  stringError = Text 500 . TL.pack+  showError _ = "schrotty exception :("++-- ------------------------------------------------------------++handleCustomError :: Monad m => WebError -> ActionSchrottyT m ()+handleCustomError (NotFound)+  = do+    status status404+    text $ "Not found."+handleCustomError (JsonInvalid s)+  = do+    status status400+    jsonPretty $ JsonFailure 400 ("json invalid: " ++ s)+handleCustomError (MissingParam txt)+  = do+    status status404+    text $ "Query parameter missing " `TL.append` txt -- TODO: fix types+handleCustomError (Other txt)+  = do+    status status500+    text $ txt+handleCustomError (Text code bs)+  = do+    status (toEnum code)+    text $ bs+handleCustomError (Json code o)+  = do+    status (toEnum code)+    jsonPretty $ JsonFailure code o+handleCustomError (InterpreterError (ResError code msg))+  = handleCustomError (Json code msg)++-- | Like 'Web.Scotty.json', but pretty.+jsonPretty :: (ToJSON a, ScottyError e, Monad m) => a -> ActionT e m ()+jsonPretty v = do+  setHeader "Content-Type" "application/json"+  raw $ AP.encodePretty v++-- | Replacement for 'Web.Scotty.jsonData' with custom error.+jsonData :: (FromJSON a, Monad m) => ActionSchrottyT m a+jsonData = do+  b <- body+  case A.eitherDecode b of+    Right j -> return j+    Left e  -> raise $ JsonInvalid e++-- | Replacement for 'Web.Scotty.param' with custom error.+param :: (Parsable a, Monad m) => TL.Text -> ActionSchrottyT m a+param p = Scotty.param p+            `rescue` (\_ -> raise $ MissingParam p)++-- ------------------------------------------------------------++-- | Start schrotty.+schrotty :: Port -> ScottyT WebError IO () -> IO ()+schrotty p a = Scotty.scottyT p id id $ defaultHandler handleCustomError >> a++-- | Start schrotty with options.+schrottyOpts :: Options -> ScottyT WebError IO () -> IO ()+schrottyOpts o a = Scotty.scottyOptsT o id id $ defaultHandler handleCustomError >> a++-- ------------------------------------------------------------