Skip to content

Hobby Haskell project building a web framework. I have reused this pattern in several haskell projects

License

Notifications You must be signed in to change notification settings

trevorsibanda/Matobo

Repository files navigation

quickweb

Example

cabal repl 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
    ]

About

Hobby Haskell project building a web framework. I have reused this pattern in several haskell projects

Resources

License

Stars

Watchers

Forks

Releases

No releases published

Packages

No packages published