Example
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Web.Matobo.Example where
import Web.Matobo
import qualified Web.Matobo.Option as O
import Control.Exception (throw)
import Control.Monad (unless)
import Data.Maybe (fromMaybe)
customErrHandler :: AppErrorHandlers
customErrHandler =
defaultErrorHandlers
{ heExceptionHandler = customExceptionErrHandler
}
data MyErrors = InvalidPage Int | InvalidRequestId String deriving (Show, Eq, Exception)
customExceptionErrHandler :: SomeException -> Handler
customExceptionErrHandler e = do
setStatusCode status500
case fromException e of
Just (InvalidPage i) -> text $ "The page number you entered " <> show i <> " is invalid"
Just (InvalidRequestId _) -> text "invalid request id"
_ -> text $ " We got an unknown exception " <> show e
conf :: ServerConfig
conf =
(defaultJSONRestApiConfig "test-custom-err" 3001)
{ scErrorHandlers = customErrHandler
}
someFunc :: IO ()
someFunc = runMatoboServer conf routes
appName :: String
appName = "test-dev"
reverseMethod :: Handler
reverseMethod = do
liftIO $ print "inside reverseMethod"
continue
--pure (context{contextMethod = "LOL"}, Halt Noop)
indexPage :: Handler
indexPage = text "index page"
sayPage :: Handler
sayPage = do
page <- capture @Int "page"
perPage <- param' @Int "per_page"
reqId <- header @String "X-Request-Id"
--setCookie "session" ("test-session-1" :: String)
path' <- path
unless (page /= 0) (throw $ InvalidPage page)
let x = 900 `div` page
--sessionStore "request" page
--next <- capture @Int "next"
text $ "hello from page " <> show x <> " showing " <> show perPage <> " items in " <> path' <> " for request " <> show reqId
data AuthRoutes = AuthRoutes
{ login :: Route,
resetPassword :: Route,
signup :: Route,
verifyEmailCallback :: Route
}
class AppRouter a where
toRoutes :: a -> Route
routesName :: a -> String
data LoginForm = LoginForm
{ username :: String,
password :: String
}
deriving (Generic, FromJSON, RequestBody, Show, Eq)
doLogin :: Handler
doLogin = do
creds' <- eitherJsonBody @LoginForm
case creds' of
Left err -> text $ show err
Right form -> text $ "Logged in as User: " <> username form
sessionAuth :: MiddlewareFunc
sessionAuth = continue
cacheResults :: Context -> ResponseContent -> IO ()
cacheResults _ _ = print "Cache results"
authenticatedPages :: Option
authenticatedPages = mempty -- O.middleware sessionAuth <> O.post cacheResults
data User = User
{ user :: String,
full_name :: String,
email :: String
}
deriving (Generic, ToJSON)
whoUser :: Handler
whoUser = do
emailCookie <- cookie "test"
setCookie' "api-key" "test-123-api-key"
json $ User "trevorsibb" "Trevor Sibanda" (fromMaybe "*empty*" emailCookie)
protectedEndpoints :: Route
protectedEndpoints =
Root' "/api/" authenticatedPages
[ GET "/user" mempty whoUser,
Root "/user" [
GET "/assets" mempty whoUser,
DELETE "/assets" mempty whoUser,
GET "/assets/:asset_id" mempty whoUser,
Root "/assets/:asset_id" [
GET "/assets" mempty whoUser,
DELETE "/assets" mempty whoUser,
GET "/assets/:asset_id" mempty whoUser
]
]
]
dynamicFileServe :: Handler
dynamicFileServe = text "serve file to download"
routes :: Route
routes =
Root
"/"
[ GET "" mempty indexPage,
STATICFS "/public/assets/*" "/Users/trevor/workspace/trevorsibanda/dist/" O.rewriteIndex,
--FILE "" [],
--GET "/public/assets/*" [] dynamicFileServe,
GET "/say/unsafe/page/:page" [] sayPage,
--
GET
"/say/page/:page"
[ O.pathValue @Int "page",
O.param @Int "per_page",
O.header @String "X-Request-Id",
O.setHeader "Content-Type" "application/json"
]
sayPage,
--
GET "/auth" (O.redirectAlways "/app/user") noop,
POST "/login" mempty doLogin,
protectedEndpoints
]