| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Wordpress.Auth
Description
The Wordpress.Auth module is used for checking the validity of various Wordpress authentication schemes.
This is useful if you want a Haskell application to be able to serve authenticated API requests to a Wordpress site without having to devise a Wordpress-to-Haskell authentication system.
You will need some constants from your Wordpress site's wp-config.php,
like the NONCE_KEY & NONCE_SALT, you could supply these via
environmental variables:
loggedInScheme <-AuthScheme<$> (wpConfigKey. T.pack <$> getEnv "LOGGED_IN_KEY") <*> (wpConfigSalt. T.pack <$> getEnv "LOGGED_IN_SALT")
Then you'll want to pull the specific cookie's text out of the Cookie
header(see findCookie) & use then parseWordpressCookie to build
a WPCookie. You should then use the username field of the cookie to
query your Wordpress database for the User's ID(WordpressUserId)
& user_pass(WordpresUserPass) fields as well as the session_tokens
User Meta(SessionToken).
Equiped with these and the current time(via
getPOSIXTime), you can then validate the cookie:
passwordFragment =WordpressUserPassmyUserTablesUserPassFieldValue sessionTokens =decodeSessionTokensmyUserMetaTablesSessionTokensMetaValue cookieIsValid =validateCookieloggedInScheme currentTime cookie passwordFragment sessionTokens
If this is a REST request or a form submission, you should always
validate the nonce, even for requests with no auth cookies. The nonce can
be pulled out of the X-WP-Nonce header or the _wpnonce query parameter.
nonceTick <-wordpressNonceTick(60 * 60 * 24) currentTime let validNonce =validateNoncenonceScheme (Just cookie) nonceTick (Just $WordpressUserIduserId) "wp_rest" myNonceText
Synopsis
- authorizeWordpressRequest :: forall m a. MonadIO m => WPAuthConfig m a -> RequestHeaders -> [QueryItem] -> m (WPAuthorization a)
- data WPAuthConfig m a = WPAuthConfig {
- getCookieName :: m CookieName
- loggedInScheme :: AuthScheme
- nonceScheme :: AuthScheme
- nonceLifetime :: NominalDiffTime
- getUserData :: Text -> m (Maybe (UserAuthData a))
- onAuthenticationFailure :: WPAuthError -> m (WPAuthorization a)
- data UserAuthData a = UserAuthData {
- userData :: a
- wpUser :: WordpressUserId
- wpPass :: WordpressUserPass
- wpTokens :: [SessionToken]
- data WPAuthorization a
- data WPAuthError
- data CookieName
- cookieName :: CookieName -> Text
- findCookie :: CookieName -> RequestHeaders -> Either CookieHeaderError Text
- data CookieHeaderError
- findNonce :: RequestHeaders -> [QueryItem] -> Maybe Text
- data WPCookie = WPCookie {
- username :: Text
- expiration :: POSIXTime
- token :: CookieToken
- hmac :: Text
- newtype CookieToken = CookieToken {
- cookieToken :: Text
- parseWordpressCookie :: Text -> Either CookieParseError WPCookie
- data CookieParseError
- validateCookie :: AuthScheme -> POSIXTime -> WPCookie -> WordpressUserPass -> [SessionToken] -> Either CookieValidationError ()
- newtype WordpressUserPass = WordpressUserPass {}
- data CookieValidationError
- validateCookieHash :: AuthScheme -> WPCookie -> WordpressUserPass -> Bool
- data SessionToken = SessionToken {}
- decodeSessionTokens :: Text -> [SessionToken]
- validateSessionToken :: POSIXTime -> CookieToken -> [SessionToken] -> Bool
- newtype NonceTick = NonceTick {}
- wordpressNonceTick :: NominalDiffTime -> POSIXTime -> NonceTick
- validateNonce :: AuthScheme -> Maybe CookieToken -> NonceTick -> Maybe WordpressUserId -> Text -> Text -> Bool
- newtype WordpressUserId = WordpressUserId {}
- wordpressHash :: AuthScheme -> Text -> Text
- wordpressSalt :: AuthScheme -> Text
- data AuthScheme = AuthScheme {}
- data WordpressKey
- data WordpressSalt
- wpConfigKey :: Text -> WordpressKey
- wpConfigSalt :: Text -> WordpressSalt
Request Handling
authorizeWordpressRequest :: forall m a. MonadIO m => WPAuthConfig m a -> RequestHeaders -> [QueryItem] -> m (WPAuthorization a) Source #
The is a generalized authentication verification scheme that
authorizes a user if the logged_in cookie is set and valid, & verifies
the wp_rest nonce action for both authorized & anonymous users.
The WPAuthConfig failure handler will be used if a Cookie is present
but invalid or if the nonce is missing/invalid.
data WPAuthConfig m a Source #
Configuration data specific to your Wordpress site & Haskell application.
Constructors
| WPAuthConfig | |
Fields
| |
data UserAuthData a Source #
The data needed for authentication, along with some arbitrary data that is returned on success.
Constructors
| UserAuthData | |
Fields
| |
Instances
| Eq a => Eq (UserAuthData a) Source # | |
Defined in Wordpress.Auth Methods (==) :: UserAuthData a -> UserAuthData a -> Bool # (/=) :: UserAuthData a -> UserAuthData a -> Bool # | |
| Show a => Show (UserAuthData a) Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> UserAuthData a -> ShowS # show :: UserAuthData a -> String # showList :: [UserAuthData a] -> ShowS # | |
data WPAuthorization a Source #
The result of the authorizeWordpressRequest function can be an
authorized user with some additional data, or an anonymous user.
Constructors
| WPAuthorizedUser a | |
| WPAnonymousUser |
Instances
| Eq a => Eq (WPAuthorization a) Source # | |
Defined in Wordpress.Auth Methods (==) :: WPAuthorization a -> WPAuthorization a -> Bool # (/=) :: WPAuthorization a -> WPAuthorization a -> Bool # | |
| Show a => Show (WPAuthorization a) Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> WPAuthorization a -> ShowS # show :: WPAuthorization a -> String # showList :: [WPAuthorization a] -> ShowS # | |
data WPAuthError Source #
Potential errors during authentication.
Constructors
| EHeader CookieHeaderError | Header Error. |
| EParse CookieParseError | Parsing Error. |
| EValid CookieValidationError | Validation Error. |
| UserDataNotFound | The |
| NoNonce | The |
| InvalidNonce | The nonce couldn't be validated. |
Instances
| Eq WPAuthError Source # | |
Defined in Wordpress.Auth | |
| Show WPAuthError Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> WPAuthError -> ShowS # show :: WPAuthError -> String # showList :: [WPAuthError] -> ShowS # | |
data CookieName Source #
The name of a Wordpress authentication cookie. Wordpress's frontend
uses CookieNameWithMD5 "wordpress_logged_in_" "<your-site-url>" by
default.
Constructors
| CustomCookieName Text | A constant name for the cookie. |
| CookieNameWithMD5 Text Text | A cookie name with some text to hash & append. E.g., Wordpress's
|
Instances
| Eq CookieName Source # | |
Defined in Wordpress.Auth | |
| Show CookieName Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> CookieName -> ShowS # show :: CookieName -> String # showList :: [CookieName] -> ShowS # | |
cookieName :: CookieName -> Text Source #
Build the name of an authentication cookie from a CookieName,
hashing the suffix if present.
findCookie :: CookieName -> RequestHeaders -> Either CookieHeaderError Text Source #
Try to find & decode a Cookie in the headers with the given name.
data CookieHeaderError Source #
Potential errors while searching for a specific cookie in the request headers.
Constructors
| NoCookieHeader | The |
| NoCookieMatches | No Cookie matched the expected |
Instances
| Eq CookieHeaderError Source # | |
Defined in Wordpress.Auth Methods (==) :: CookieHeaderError -> CookieHeaderError -> Bool # (/=) :: CookieHeaderError -> CookieHeaderError -> Bool # | |
| Show CookieHeaderError Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> CookieHeaderError -> ShowS # show :: CookieHeaderError -> String # showList :: [CookieHeaderError] -> ShowS # | |
findNonce :: RequestHeaders -> [QueryItem] -> Maybe Text Source #
Try to find & decode a Nonce in either the X-WP-Nonce header or the
_wpnonce query parameter.
Cookies
This represents a Cookie set by a Wordpress authentication scheme
(auth, auth_sec, & logged_in).
Constructors
| WPCookie | |
Fields
| |
newtype CookieToken Source #
A User's Wordpress Session Token from an auth cookie.
Constructors
| CookieToken | |
Fields
| |
Instances
| Eq CookieToken Source # | |
Defined in Wordpress.Auth | |
| Show CookieToken Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> CookieToken -> ShowS # show :: CookieToken -> String # showList :: [CookieToken] -> ShowS # | |
parseWordpressCookie :: Text -> Either CookieParseError WPCookie Source #
Parse a WPCookie from the body text of an auth, auth_sec, or
logged_in cookie.
data CookieParseError Source #
Potential errors we may encounter while parsing a WPCookie.
Constructors
| MalformedCookie | The cookie did not have 4 fields separated by `|` characters. |
| InvalidExpiration | The |
Instances
| Eq CookieParseError Source # | |
Defined in Wordpress.Auth Methods (==) :: CookieParseError -> CookieParseError -> Bool # (/=) :: CookieParseError -> CookieParseError -> Bool # | |
| Show CookieParseError Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> CookieParseError -> ShowS # show :: CookieParseError -> String # showList :: [CookieParseError] -> ShowS # | |
Arguments
| :: AuthScheme | They |
| -> POSIXTime | The current time. |
| -> WPCookie | The cookie to validate. |
| -> WordpressUserPass | The |
| -> [SessionToken] | The |
| -> Either CookieValidationError () |
Validate a Wordpress Authentication Cookie by verifying that the hash & token in the cookie are valid and the expiration time is in the future.
newtype WordpressUserPass Source #
The user_pass field from the users table of a Wordpress site.
Constructors
| WordpressUserPass | |
Fields | |
Instances
| Eq WordpressUserPass Source # | |
Defined in Wordpress.Auth Methods (==) :: WordpressUserPass -> WordpressUserPass -> Bool # (/=) :: WordpressUserPass -> WordpressUserPass -> Bool # | |
| Show WordpressUserPass Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> WordpressUserPass -> ShowS # show :: WordpressUserPass -> String # showList :: [WordpressUserPass] -> ShowS # | |
data CookieValidationError Source #
Potential validation errors for a WPCookie.
Constructors
| CookieExpired | The |
| InvalidHash | The |
| InvalidToken | The |
Instances
| Eq CookieValidationError Source # | |
Defined in Wordpress.Auth Methods (==) :: CookieValidationError -> CookieValidationError -> Bool # (/=) :: CookieValidationError -> CookieValidationError -> Bool # | |
| Show CookieValidationError Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> CookieValidationError -> ShowS # show :: CookieValidationError -> String # showList :: [CookieValidationError] -> ShowS # | |
validateCookieHash :: AuthScheme -> WPCookie -> WordpressUserPass -> Bool Source #
Session Tokens
data SessionToken Source #
A User Session's Token. These can be found in the usermeta Wordpress
table for rows where meta_key="session_token".
You'll probably want to use decodeSessionTokens to parse the tables's
meta_value instead of constructing them yourself.
Constructors
| SessionToken | |
Fields | |
Instances
| Eq SessionToken Source # | |
Defined in Wordpress.Auth | |
| Show SessionToken Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> SessionToken -> ShowS # show :: SessionToken -> String # showList :: [SessionToken] -> ShowS # | |
decodeSessionTokens :: Text -> [SessionToken] Source #
Decode a serialized PHP array containing a User's Session Tokens.
These are usually stored as the session_tokens usermeta.
It may be an associative array of tokens to expiration times, or tokens to an associative array of sub-fields:
array(
'some-random-hex-text' => 192836504,
// ...
);
array(
'deadbeef ' => array(
'expiration' => 9001,
// ...
),
);Arguments
| :: POSIXTime | The current time |
| -> CookieToken | The session token from a |
| -> [SessionToken] | A list of the User's session tokens |
| -> Bool |
Determine if the SHA256 hash of the token matches one of the unexpired session tokens.
Nonces
The tick number of a Wordpress site - required for Nonce verification.
Arguments
| :: NominalDiffTime | The nonce lifetime. Wordpress's default is 1 day. |
| -> POSIXTime | The current time. |
| -> NonceTick |
A port of the wp_nonce_tick function. Calculates the nonce tick
number, where each nonce has a lifetime of two ticks.
Arguments
| :: AuthScheme | The Wordpress site's |
| -> Maybe CookieToken | A token from the |
| -> NonceTick | The current tick number. |
| -> Maybe WordpressUserId | The ID of the currently logged in User. |
| -> Text | The |
| -> Text | The nonce to verify. |
| -> Bool |
Determine if the tick-dependent hash of the CookieToken matches the
hash of the current or previous tick.
newtype WordpressUserId Source #
The ID field from the users table of a Wordpress site.
Constructors
| WordpressUserId | |
Fields | |
Instances
| Eq WordpressUserId Source # | |
Defined in Wordpress.Auth Methods (==) :: WordpressUserId -> WordpressUserId -> Bool # (/=) :: WordpressUserId -> WordpressUserId -> Bool # | |
| Show WordpressUserId Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> WordpressUserId -> ShowS # show :: WordpressUserId -> String # showList :: [WordpressUserId] -> ShowS # | |
Hashing / Salting
wordpressHash :: AuthScheme -> Text -> Text Source #
A port of the wp_hash function. This performs an hmac hash on
some text using a secret derived from the authentication scheme's key
& salt constants.
wordpressSalt :: AuthScheme -> Text Source #
A port of the wp_salt function. Builds a secret key for a hashing
function using the auth scheme's key & salt.
data AuthScheme Source #
This represents one of the $schemes that Wordpress's cookie/nonce
functions use to salt their hashes.
The built-in Wordpress schemes are auth/auth_sec for HTTP/HTTPS
requests to wp-admin, logged_in for authenticated front-end
requests, & nonce for form submissions & API requests.
The secret keys & salts are constants found in your wp-config.php
file, defined as LOGGED_IN_SALT, LOGGED_IN_KEY, etc.
Constructors
| AuthScheme | |
Fields | |
Instances
| Eq AuthScheme Source # | |
Defined in Wordpress.Auth | |
| Show AuthScheme Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> AuthScheme -> ShowS # show :: AuthScheme -> String # showList :: [AuthScheme] -> ShowS # | |
data WordpressKey Source #
An auth scheme's _KEY constant, usually defined in your Wordpress
site's wp-config.php. E.g., LOGGED_IN_KEY
Instances
| Eq WordpressKey Source # | |
Defined in Wordpress.Auth | |
| Show WordpressKey Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> WordpressKey -> ShowS # show :: WordpressKey -> String # showList :: [WordpressKey] -> ShowS # | |
data WordpressSalt Source #
An auth scheme's _SALT constant, usually defined in your Wordpress
site's wp-config.php. E.g., LOGGED_IN_SALT
Instances
| Eq WordpressSalt Source # | |
Defined in Wordpress.Auth Methods (==) :: WordpressSalt -> WordpressSalt -> Bool # (/=) :: WordpressSalt -> WordpressSalt -> Bool # | |
| Show WordpressSalt Source # | |
Defined in Wordpress.Auth Methods showsPrec :: Int -> WordpressSalt -> ShowS # show :: WordpressSalt -> String # showList :: [WordpressSalt] -> ShowS # | |
wpConfigKey :: Text -> WordpressKey Source #
Build the _KEY value for an authentiation scheme.
wpConfigSalt :: Text -> WordpressSalt Source #
Build the _SALT value for an authentiation scheme.