{- | This module presents a Servant 'AuthHandler' that validates
a @LOGGED_IN@ Wordpress Cookie & the @"wp_rest"@ Nonce.

You'll need to build a 'WPAuthConfig' for your application to pass to
the 'wpAuthHandler' function. The config defines some specifics about your
Wordpress site, as well as functions to pull a User's authentication data
& to handle authentication failures.

You must define the 'Servant.Server.Experimental.Auth.AuthServerData' type
instance yourself:

> type instance "AuthServerData" ("AuthProtect" \"wp\") = WPAuthorization (Entity User)

For more information, be sure to check out the
<https://haskell-servant.readthedocs.io/en/stable/tutorial/Authentication.html#generalized-authentication Generalized Authentication>
section of the servant tutorial.

If you want to build your own custom 'AuthHandler', check out the
"Wordpress.Auth" module.

-}
module Servant.Auth.Wordpress
    (
    -- * Auth Handlers
      wpAuthHandler
    , wpAuthorizedOnlyHandler
    , WPAuthorization(..)
    -- * Configs
    , WPAuthConfig(..)
    , CookieName(..)
    , AuthScheme(..)
    , WordpressKey
    , wpConfigKey
    , WordpressSalt
    , wpConfigSalt
    , UserAuthData(..)
    , WordpressUserId(..)
    , WordpressUserPass(..)
    , SessionToken(..)
    , decodeSessionTokens
    -- * Errors
    , WPAuthError(..)
    , CookieHeaderError(..)
    , CookieParseError(..)
    , CookieValidationError(..)
    )
where

import           Network.Wai                    ( Request
                                                , requestHeaders
                                                , queryString
                                                )
import           Servant                        ( Handler )
import           Servant.Server.Experimental.Auth
                                                ( AuthHandler
                                                , mkAuthHandler
                                                )
import           Wordpress.Auth                 ( WPAuthConfig(..)
                                                , UserAuthData(..)
                                                , WPAuthorization(..)
                                                , authorizeWordpressRequest
                                                , WPAuthError(..)
                                                , AuthScheme(..)
                                                , CookieName(..)
                                                , CookieHeaderError(..)
                                                , CookieParseError(..)
                                                , CookieValidationError(..)
                                                , WordpressUserId(..)
                                                , WordpressUserPass(..)
                                                , SessionToken(..)
                                                , decodeSessionTokens
                                                , WordpressKey
                                                , wpConfigKey
                                                , WordpressSalt
                                                , wpConfigSalt
                                                , findCookie
                                                )


-- | A Servant Authentication Handler that valiates a @logged_in@ Cookie
-- & a @wp_rest@ Nonce.
wpAuthHandler
    :: WPAuthConfig Handler a -> AuthHandler Request (WPAuthorization a)
wpAuthHandler :: WPAuthConfig Handler a -> AuthHandler Request (WPAuthorization a)
wpAuthHandler = (Request -> Handler (WPAuthorization a))
-> AuthHandler Request (WPAuthorization a)
forall r usr. (r -> Handler usr) -> AuthHandler r usr
mkAuthHandler ((Request -> Handler (WPAuthorization a))
 -> AuthHandler Request (WPAuthorization a))
-> (WPAuthConfig Handler a
    -> Request -> Handler (WPAuthorization a))
-> WPAuthConfig Handler a
-> AuthHandler Request (WPAuthorization a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WPAuthConfig Handler a -> Request -> Handler (WPAuthorization a)
forall a.
WPAuthConfig Handler a -> Request -> Handler (WPAuthorization a)
handler

-- | This is similar to 'wpAuthHandler' but it allows you to throw an error
-- for anonymous users with valid nonces - restricting handlers to only
-- logged in users.
wpAuthorizedOnlyHandler
    :: WPAuthConfig Handler a
    -> (WPAuthError -> Handler a)
    -> AuthHandler Request a
wpAuthorizedOnlyHandler :: WPAuthConfig Handler a
-> (WPAuthError -> Handler a) -> AuthHandler Request a
wpAuthorizedOnlyHandler WPAuthConfig Handler a
cfg WPAuthError -> Handler a
authFailure = (Request -> Handler a) -> AuthHandler Request a
forall r usr. (r -> Handler usr) -> AuthHandler r usr
mkAuthHandler ((Request -> Handler a) -> AuthHandler Request a)
-> (Request -> Handler a) -> AuthHandler Request a
forall a b. (a -> b) -> a -> b
$ \Request
req -> do
    WPAuthorization a
result <- WPAuthConfig Handler a -> Request -> Handler (WPAuthorization a)
forall a.
WPAuthConfig Handler a -> Request -> Handler (WPAuthorization a)
handler WPAuthConfig Handler a
cfg Request
req
    case WPAuthorization a
result of
        WPAuthorizedUser a
uData -> a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return a
uData
        WPAuthorization a
WPAnonymousUser        -> do
            CookieName
name <- WPAuthConfig Handler a -> Handler CookieName
forall (m :: * -> *) a. WPAuthConfig m a -> m CookieName
getCookieName WPAuthConfig Handler a
cfg
            WPAuthError -> Handler a
authFailure
                (WPAuthError -> Handler a) -> WPAuthError -> Handler a
forall a b. (a -> b) -> a -> b
$ (CookieHeaderError -> WPAuthError)
-> (Text -> WPAuthError)
-> Either CookieHeaderError Text
-> WPAuthError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CookieHeaderError -> WPAuthError
EHeader (WPAuthError -> Text -> WPAuthError
forall a b. a -> b -> a
const (WPAuthError -> Text -> WPAuthError)
-> WPAuthError -> Text -> WPAuthError
forall a b. (a -> b) -> a -> b
$ CookieHeaderError -> WPAuthError
EHeader CookieHeaderError
NoCookieMatches)
                (Either CookieHeaderError Text -> WPAuthError)
-> Either CookieHeaderError Text -> WPAuthError
forall a b. (a -> b) -> a -> b
$ CookieName -> RequestHeaders -> Either CookieHeaderError Text
findCookie CookieName
name (Request -> RequestHeaders
requestHeaders Request
req)


handler :: WPAuthConfig Handler a -> Request -> Handler (WPAuthorization a)
handler :: WPAuthConfig Handler a -> Request -> Handler (WPAuthorization a)
handler WPAuthConfig Handler a
cfg Request
req =
    WPAuthConfig Handler a
-> RequestHeaders -> [QueryItem] -> Handler (WPAuthorization a)
forall (m :: * -> *) a.
MonadIO m =>
WPAuthConfig m a
-> RequestHeaders -> [QueryItem] -> m (WPAuthorization a)
authorizeWordpressRequest WPAuthConfig Handler a
cfg (Request -> RequestHeaders
requestHeaders Request
req) (Request -> [QueryItem]
queryString Request
req)