diff --git a/.travis.yml b/.travis.yml index 2a8b4b54..2e9d3d3f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,7 +4,7 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.3.20190326 +# version: 0.3.20190413 # language: c dist: xenial @@ -122,6 +122,7 @@ install: if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "doc/cookbook/structuring-apis"' >> cabal.project ; fi if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "doc/cookbook/using-custom-monad"' >> cabal.project ; fi if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "doc/cookbook/using-free-client"' >> cabal.project ; fi + if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "doc/cookbook/open-id-connect"' >> cabal.project ; fi - | echo "constraints: foundation >=0.0.14" >> cabal.project echo "constraints: memory <0.14.12 || >0.14.12" >> cabal.project @@ -132,7 +133,7 @@ install: echo "allow-newer: servant-quickcheck:http-client" >> cabal.project echo "optimization: False" >> cabal.project echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-https|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-https|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|open-id-connect|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "servant/configure.ac" ]; then (cd "servant" && autoreconf -i); fi @@ -159,6 +160,10 @@ install: - if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then (cd "doc/cookbook/structuring-apis" && autoreconf -i); fi - if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then (cd "doc/cookbook/using-custom-monad" && autoreconf -i); fi - if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then (cd "doc/cookbook/using-free-client" && autoreconf -i); fi + - if [ -f "doc/cookbook/open-id-connect/configure.ac" ]; then (cd "doc/cookbook/open-id-connect" && autoreconf -i); fi + - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output + - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" + - rm cabal.project.freeze script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... @@ -198,6 +203,7 @@ script: if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "cookbook-structuring-apis-*/*.cabal"' >> cabal.project ; fi if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "cookbook-using-custom-monad-*/*.cabal"' >> cabal.project ; fi if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "cookbook-using-free-client-*/*.cabal"' >> cabal.project ; fi + if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80604 ] ; then echo 'packages: "open-id-connect-*/*.cabal"' >> cabal.project ; fi - | echo "constraints: foundation >=0.0.14" >> cabal.project echo "constraints: memory <0.14.12 || >0.14.12" >> cabal.project @@ -208,7 +214,7 @@ script: echo "allow-newer: servant-quickcheck:http-client" >> cabal.project echo "optimization: False" >> cabal.project echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-https|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-https|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|open-id-connect|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - echo -en 'travis_fold:end:unpack\\r' diff --git a/cabal.project b/cabal.project index 7c88a106..371dba5d 100644 --- a/cabal.project +++ b/cabal.project @@ -30,6 +30,7 @@ packages: doc/cookbook/structuring-apis doc/cookbook/using-custom-monad doc/cookbook/using-free-client + doc/cookbook/open-id-connect tests: True optimization: False diff --git a/doc/cookbook/cabal.project b/doc/cookbook/cabal.project index 4b12a08a..9ed89308 100644 --- a/doc/cookbook/cabal.project +++ b/doc/cookbook/cabal.project @@ -12,6 +12,7 @@ packages: pagination/ sentry/ testing/ + open-id-connect/ ../../servant ../../servant-server ../../servant-client-core diff --git a/doc/cookbook/cabal.project.local b/doc/cookbook/cabal.project.local new file mode 100644 index 00000000..e69de29b diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst index d276d6fa..4f54cbe0 100644 --- a/doc/cookbook/index.rst +++ b/doc/cookbook/index.rst @@ -32,3 +32,4 @@ you name it! curl-mock/CurlMock.lhs sentry/Sentry.lhs testing/Testing.lhs + open-id-connect/OpenIdConnect.lhs diff --git a/doc/cookbook/open-id-connect/OpenIdConnect.cabal b/doc/cookbook/open-id-connect/OpenIdConnect.cabal new file mode 100644 index 00000000..224f4895 --- /dev/null +++ b/doc/cookbook/open-id-connect/OpenIdConnect.cabal @@ -0,0 +1,45 @@ +name: open-id-connect +version: 0.1 +synopsis: OpenId Connect with Servant example +homepage: http://haskell-servant.readthedocs.org/ +license: BSD3 +license-file: ../../../servant/LICENSE +author: Servant Contributors +maintainer: haskell-servant-maintainers@googlegroups.com +build-type: Simple +cabal-version: >= 1.10 +tested-with: GHC==8.4.4, GHC==8.6.4 + +executable cookbook-openidconnect + main-is: OpenIdConnect.lhs + build-depends: base ==4.* + , aeson + , aeson-pretty + , binary + , blaze-html + , blaze-markup + , bytestring + , case-insensitive + , cereal + , containers + , generic-lens + , http-client + , http-client-tls + , http-types + , jose-jwt + , lens + , lens-aeson + , oidc-client + , protolude + , random + , servant + , servant-blaze + , servant-server + , text + , time + , vector + , wai + , warp >= 3.2 + default-language: Haskell2010 + ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -pgmL markdown-unlit + build-tool-depends: markdown-unlit:markdown-unlit >= 0.4 diff --git a/doc/cookbook/open-id-connect/OpenIdConnect.lhs b/doc/cookbook/open-id-connect/OpenIdConnect.lhs new file mode 100644 index 00000000..f94a9219 --- /dev/null +++ b/doc/cookbook/open-id-connect/OpenIdConnect.lhs @@ -0,0 +1,472 @@ +[OpenID Connect](https://openid.net/connect/) +============================================= + +Use OpenID Connect to authenticate your users. +This example use google OIDC provider. +It was made for a working with single page application where +some login token would be saved in the user agent local storage. + +Workflow: + +1. user is presentend with a login button, +2. when the user click on the button it is redirected to the OIDC + provider, +3. the user login in the OIDC provider, +4. the OIDC provider will redirect the user and provide a `code`, +5. the server will use this code to make a POST to the OIDC provider + and will get back authentication infos, +6. The user will get display an HTML page that will save a secret + identifying him in the local storage, then it will be redirected to + /. + +Let's put the imports behind us: + +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Main where + +import Protolude + +import Data.Aeson + (FromJSON (..), (.:)) +import qualified Data.Aeson as JSON +import qualified Data.Aeson.Types as AeT +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as List +import qualified Data.Text as Text +import Jose.Jwt + (Jwt (..), decodeClaims) +import Network.HTTP.Client + (Manager, newManager) +import Network.HTTP.Client.TLS + (tlsManagerSettings) +import Network.Wai.Handler.Warp + (run) +import Servant +import Servant.HTML.Blaze + (HTML) +import qualified System.Random as Random +import Text.Blaze + (ToMarkup (..)) +import qualified Text.Blaze.Html as H +import Text.Blaze.Html5 + ((!)) +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as HA +import Text.Blaze.Renderer.Utf8 + (renderMarkup) +import qualified Web.OIDC.Client as O +``` + +You'll need to create a new OpenID Connect client in an OpenID Provider. +This example was tested with Google. + +You can find a list of public OIDC provider here: +https://connect2id.com/products/nimbus-oauth-openid-connect-sdk/openid-connect-providers + +I copied some here: + +- Google: https://developers.google.com/identity/protocols/OpenIDConnect + more precisely: https://console.developers.google.com/apis/credentials +- Microsoft: https://docs.microsoft.com/en-us/previous-versions/azure/dn645541(v=azure.100) +- Yahoo: https://developer.yahoo.com/oauth2/guide/openid_connect/ +- PayPal: https://developer.paypal.com/docs/integration/direct/identity/log-in-with-paypal/ + +During the configuration you'll need to provide a redirect uri. +The redirect_uri should correspond to the uri user will be redirected to +after a successful login into the OpenID provider. + +So during your test, you should certainly just use `http://localhost:3000/login/cb`. +In general you should use your own domain name. + +You'll then be given a `client_id` and a `client_password`. +Fill those values in here: + +``` haskell +oidcConf :: OIDCConf +oidcConf = OIDCConf { redirectUri = "http://localhost:3000/login/cb" + , clientId = "xxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com" + , clientPassword = "************************" } +``` + +Then we declare our main server: + +``` haskell +main :: IO () +main = do + oidcEnv <- initOIDC oidcConf + run 3000 (app oidcEnv) + +type API = IdentityRoutes Customer + :<|> Get '[HTML] Homepage + +api :: Proxy API +api = Proxy + +server :: OIDCEnv -> Server API +server oidcEnv = serveOIDC oidcEnv handleOIDCLogin + :<|> return Homepage + +-- | Then main app +app :: OIDCEnv -> Application +app oidcEnv = serve api (server oidcEnv) +``` + +OIDC +---- + +That part try to separate concern, and certainly in a real world +application that should be in its distinct module. + +``` haskell +-- * OIDC + +data OIDCConf = + OIDCConf { redirectUri :: ByteString + , clientId :: ByteString + , clientPassword :: ByteString + } deriving (Show, Eq) +``` + +First we need to initialize OIDC. +A short explanation about it: + +- to complete the workflow we need to make a POST request to the OIDC provider. + So we need to create an http manager to make those call properly. +- Then in order to prevent replay attack, each time an user wants to login we + should provide a random string called the `state`. When the user is + redirected to the `redirect_uri`, the OIDC provider should provide the same + `state` along a `code` parameter. + +``` haskell +initOIDC :: OIDCConf -> IO OIDCEnv +initOIDC OIDCConf{..} = do + mgr <- newManager tlsManagerSettings + prov <- O.discover "https://accounts.google.com" mgr + let oidc = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov) + return OIDCEnv { oidc = oidc + , mgr = mgr + , genState = genRandomBS + , prov = prov + , redirectUri = redirectUri + , clientId = clientId + , clientPassword = clientPassword + } + +data OIDCEnv = OIDCEnv { oidc :: O.OIDC + , mgr :: Manager + , genState :: IO ByteString + , prov :: O.Provider + , redirectUri :: ByteString + , clientId :: ByteString + , clientPassword :: ByteString + } +``` + +The `IdentityRoutes` are two endpoints: + +- an endpoint to redirect the users to the OIDC Provider, +- another one the user will be redirected to from the OIDC Provider. + +``` haskell +type IdentityRoutes a = + "login" :> ( -- redirect User to the OpenID Provider + Get '[JSON] NoContent + -- render the page that will save the user creds in the user-agent + :<|> "cb" :> QueryParam "error" Text + :> QueryParam "code" Text + :> Get '[HTML] User) + +-- | gen a 302 redirect helper +redirects :: (StringConv s ByteString) => s -> Handler () +redirects url = throwError err302 { errHeaders = [("Location",toS url)]} +``` + +That function will generate the URL to redirect the users to when +they'll click on the login link: `https://yourdomain/login`. + +``` haskell +genOIDCURL :: OIDCEnv -> IO ByteString +genOIDCURL OIDCEnv{..} = do + st <- genState -- generate a random string + let oidcCreds = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov) + loc <- O.getAuthenticationRequestUrl oidcCreds [O.openId, O.email, O.profile] (Just st) [] + return (show loc) + +handleLogin :: OIDCEnv -> Handler NoContent +handleLogin oidcenv = do + loc <- liftIO (genOIDCURL oidcenv) + redirects loc + return NoContent +``` + +The `AuthInfo` is about the infos we can grab from OIDC provider. + +To be more precise, the user should come with a `code` (a token) and +POSTing that code to the correct OIDC provider endpoint should return a JSON +object. One of the field should be named `id_token` which should be a +JWT containing all the informations we need. Depending on the scopes we +asked we might get more informations. + +``` haskell +-- | @AuthInfo@ +data AuthInfo = AuthInfo { email :: Text + , emailVerified :: Bool + , name :: Text } deriving (Eq, Show, Generic) + +instance FromJSON AuthInfo where + parseJSON (JSON.Object v) = do + email :: Text <- v .: "email" + email_verified :: Bool <- v .: "email_verified" + name :: Text <- v .: "name" + return $ AuthInfo (toS email) email_verified (toS name) + parseJSON invalid = AeT.typeMismatch "Coord" invalid +instance JSON.ToJSON AuthInfo where + toJSON (AuthInfo e ev n) = + JSON.object [ "email" JSON..= (toS e :: Text) + , "email_verified" JSON..= ev + , "name" JSON..= (toS n :: Text) + ] + +type LoginHandler = AuthInfo -> IO (Either Text User) +``` + +The `handleLoggedIn` is that part that will retrieve the informations from +the user once he is redirected from the OIDC Provider after login. + +If the user is redirected to the `redirect_uri` but with an `error` query +parameter then it means something goes wrong. +If there is no error query param but a `code` query param it means the user +sucessfully logged in. From there we need to make a request to the token +endpoint of the OIDC provider. Its a POST that should contains the code +as well as the client id & secret. +This is the role of the `requestTokens` to make this HTTP POST. + +From there we extract the `claims` of the JWT contained in one of the value +of the JSON returned by the POST HTTP Request. + +``` haskell +data User = User { userId :: Text + , userSecret :: Text + , localStorageKey :: Text + , redirectUrl :: Maybe Text + } deriving (Show,Eq,Ord) + +handleLoggedIn :: OIDCEnv + -> LoginHandler -- ^ handle successful id + -> Maybe Text -- ^ error + -> Maybe Text -- ^ code + -> Handler User +handleLoggedIn oidcenv handleSuccessfulId err mcode = + case err of + Just errorMsg -> forbidden errorMsg + Nothing -> case mcode of + Just oauthCode -> do + tokens <- liftIO $ O.requestTokens (oidc oidcenv) (toS oauthCode) (mgr oidcenv) + putText . show . O.claims . O.idToken $ tokens + let jwt = toS . unJwt . O.jwt . O.idToken $ tokens + eAuthInfo = decodeClaims jwt :: Either O.JwtError (O.JwtHeader,AuthInfo) + case eAuthInfo of + Left jwtErr -> forbidden $ "JWT decode/check problem: " <> show jwtErr + Right (_,authInfo) -> + if emailVerified authInfo + then do + user <- liftIO $ handleSuccessfulId authInfo + either forbidden return user + else forbidden "Please verify your email" + Nothing -> do + liftIO $ putText "No code param" + forbidden "no code parameter given" +``` + +When you render a User with blaze-html, it will generate a page with a js +that will put a secret for that user in the local storage. And it will +redirect the user to /. + +``` haskell +instance ToMarkup User where + toMarkup User{..} = H.docTypeHtml $ do + H.head $ + H.title "Logged In" + H.body $ do + H.h1 "Logged In" + H.p (H.toHtml ("Successful login with id " <> userId)) + H.script (H.toHtml ("localStorage.setItem('" <> localStorageKey <> "','" <> userSecret <> "');" + <> "localStorage.setItem('user-id','" <> userId <> "');" + <> "window.location='" <> fromMaybe "/" redirectUrl <> "';" -- redirect the user to / + )); + +serveOIDC :: OIDCEnv -> LoginHandler -> Server (IdentityRoutes a) +serveOIDC oidcenv loginHandler = + handleLogin oidcenv :<|> handleLoggedIn oidcenv loginHandler + +-- * Auth +type APIKey = ByteString +type Account = Text.Text +type Conf = [(APIKey,Account)] +data Customer = Customer { + account :: Account + , apiKey :: APIKey + , mail :: Maybe Text + , fullname :: Maybe Text + } +``` + +Here is the code that display the homepage. +It should contain a link to the the `/login` URL. +When the user will click on this link it will be redirected to Google login page +with some generated informations. + +The page also display the content of the local storage. +And in particular the items `api-key` and `user-id`. +Those items should be set after a successful login when the user is redirected to +`/login/cb`. + +The logic used generally is to use that api-key to uniquely identify an user. +Another option would have been to set a cookie. + +``` haskell +data Homepage = Homepage + +instance ToMarkup Homepage where + toMarkup Homepage = H.docTypeHtml $ do + H.head $ do + H.title "OpenID Connect Servant Example" + H.style (H.toHtml ("body { font-family: monospace; font-size: 18px; }" :: Text.Text)) + H.body $ do + H.h1 "OpenID Connect Servant Example" + H.div $ + H.a ! HA.href "/login" $ "Click here to login" + H.ul $ do + H.li $ do + H.span "API Key in Local storage: " + H.script (H.toHtml ("document.write(localStorage.getItem('api-key'));" :: Text.Text)) + H.li $ do + H.span "User ID in Local storage: " + H.script (H.toHtml ("document.write(localStorage.getItem('user-id'));" :: Text.Text)) +``` + +We need some helpers to generate random string for generating state and API Keys. + +``` haskell +-- | generate a random Bystestring, not necessarily extremely good randomness +-- still the password will be long enough to be very difficult to crack +genRandomBS :: IO ByteString +genRandomBS = do + g <- Random.newStdGen + Random.randomRs (0, n) g & take 42 & fmap toChar & readable 0 & toS & return + where + n = length letters - 1 + toChar i = letters List.!! i + letters = ['A'..'Z'] <> ['0'..'9'] <> ['a'..'z'] + readable :: Int -> [Char] -> [Char] + readable _ [] = [] + readable i str = + let blocksize = case n of + 0 -> 8 + 1 -> 4 + 2 -> 4 + 3 -> 4 + _ -> 12 + block = take blocksize str + rest = drop blocksize str + in if List.null rest + then str + else block <> "-" <> readable (i+1) rest + +customerFromAuthInfo :: AuthInfo -> IO Customer +customerFromAuthInfo authinfo = do + apikey <- genRandomBS + return Customer { account = toS (email authinfo) + , apiKey = apikey + , mail = Just (toS (email authinfo)) + , fullname = Just (toS (name authinfo)) + } + +handleOIDCLogin :: LoginHandler +handleOIDCLogin authInfo = do + custInfo <- customerFromAuthInfo authInfo + if emailVerified authInfo + then return . Right . customerToUser $ custInfo + else return (Left "You emails is not verified by your provider. Please verify your email.") + where + customerToUser :: Customer -> User + customerToUser c = + User { userId = toS (account c) + , userSecret = toS (apiKey c) + , redirectUrl = Nothing + , localStorageKey = "api-key" + } +``` + +`Error` helpers +--------------- + +``` haskell +data Err = Err { errTitle :: Text + , errMsg :: Text } + +instance ToMarkup Err where + toMarkup Err{..} = H.docTypeHtml $ do + H.head $ do + H.title "Error" + H.body $ do + H.h1 (H.a ! HA.href "/" $ "Home") + H.h2 (H.toHtml errTitle) + H.p (H.toHtml errMsg) + +format :: ToMarkup a => a -> LBS.ByteString +format err = toMarkup err & renderMarkup + +appToErr :: ServerError -> Text -> ServerError +appToErr x msg = x + { errBody = toS $ format (Err (toS (errReasonPhrase x)) msg) + , errHeaders = [("Content-Type","text/html")]} + +unauthorized :: (MonadError ServerError m) => Text -> m a +unauthorized = throwError . unauthorizedErr + +unauthorizedErr :: Text -> ServerError +unauthorizedErr = appToErr err401 + +forbidden :: (MonadError ServerError m) => Text -> m a +forbidden = throwError . forbiddenErr + +forbiddenErr :: Text -> ServerError +forbiddenErr = appToErr err403 + +notFound :: ( MonadError ServerError m) => Text -> m a +notFound = throwError . notFoundErr + +notFoundErr :: Text -> ServerError +notFoundErr = appToErr err404 + +preconditionFailed :: ( MonadError ServerError m) => Text -> m a +preconditionFailed = throwError . preconditionFailedErr + +preconditionFailedErr :: Text -> ServerError +preconditionFailedErr = appToErr err412 + +serverError :: ( MonadError ServerError m) => Text -> m a +serverError = throwError . serverErrorErr + +serverErrorErr :: Text -> ServerError +serverErrorErr = appToErr err500 +```