{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| 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@('WordpressUserPass') fields as well as the @session_tokens@
User Meta('SessionToken').

Equiped with these and the current time(via
'Data.Time.Clock.POSIX.getPOSIXTime'), you can then validate the cookie:

@
 passwordFragment = 'WordpressUserPass' myUserTablesUserPassFieldValue
 sessionTokens    = 'decodeSessionTokens' myUserMetaTablesSessionTokensMetaValue
 cookieIsValid    = 'validateCookie' loggedInScheme 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 = 'validateNonce' nonceScheme (Just cookie) nonceTick
                                (Just $ 'WordpressUserId' userId)
                                "wp_rest" myNonceText
@

-}
module Wordpress.Auth
    (
    -- * Request Handling
      authorizeWordpressRequest
    , WPAuthConfig(..)
    , UserAuthData(..)
    , WPAuthorization(..)
    , WPAuthError(..)
    , CookieName(..)
    , cookieName
    , findCookie
    , CookieHeaderError(..)
    , findNonce
    -- * Cookies
    , WPCookie(..)
    , CookieToken(..)
    , parseWordpressCookie
    , CookieParseError(..)
    , validateCookie
    , WordpressUserPass(..)
    , CookieValidationError(..)
    , validateCookieHash
    -- * Session Tokens
    , SessionToken(..)
    , decodeSessionTokens
    , validateSessionToken
    -- * Nonces
    , NonceTick(..)
    , wordpressNonceTick
    , validateNonce
    , WordpressUserId(..)
    -- * Hashing / Salting
    , wordpressHash
    , wordpressSalt
    , AuthScheme(..)
    , WordpressKey
    , WordpressSalt
    , wpConfigKey
    , wpConfigSalt
    )
where

import           Control.Applicative            ( (<|>) )
import           Control.Monad                  ( (<=<)
                                                , join
                                                , void
                                                , unless
                                                )
import           Control.Monad.Except           ( MonadIO
                                                , ExceptT
                                                , withExceptT
                                                , runExceptT
                                                , liftEither
                                                , liftIO
                                                , lift
                                                , throwError
                                                )
import qualified Crypto.Hash.MD5               as MD5
import qualified Crypto.Hash.SHA256            as SHA256
import qualified Data.ByteString               as B
import qualified Data.ByteString.Base16        as Base16
import qualified Data.ByteString.Lazy          as LBS
import qualified Data.List                     as L
import           Data.Maybe                     ( mapMaybe
                                                , isJust
                                                )
import           Data.PHPSession                ( PHPSessionValue(..)
                                                , decodePHPSessionValue
                                                )
import qualified Data.Text                     as T
import           Data.Text                      ( Text )
import           Data.Text.Encoding             ( encodeUtf8
                                                , decodeUtf8
                                                )
import           Data.Time.Clock                ( NominalDiffTime )
import           Data.Time.Clock.POSIX          ( POSIXTime
                                                , getPOSIXTime
                                                )
import           Network.HTTP.Types             ( RequestHeaders
                                                , QueryItem
                                                )
import qualified Network.URI.Encode            as URI
import           Text.Read                      ( readMaybe )
import           Web.Cookie                     ( parseCookiesText )


-- Request Handling

-- | 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.
authorizeWordpressRequest
    :: forall m a
     . MonadIO m
    => WPAuthConfig m a
    -> RequestHeaders
    -> [QueryItem]
    -> m (WPAuthorization a)
authorizeWordpressRequest :: WPAuthConfig m a
-> RequestHeaders -> [QueryItem] -> m (WPAuthorization a)
authorizeWordpressRequest WPAuthConfig m a
cfg RequestHeaders
headers [QueryItem]
query =
    (WPAuthError -> m (WPAuthorization a))
-> (WPAuthorization a -> m (WPAuthorization a))
-> Either WPAuthError (WPAuthorization a)
-> m (WPAuthorization a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WPAuthConfig m a -> WPAuthError -> m (WPAuthorization a)
forall (m :: * -> *) a.
WPAuthConfig m a -> WPAuthError -> m (WPAuthorization a)
onAuthenticationFailure WPAuthConfig m a
cfg) WPAuthorization a -> m (WPAuthorization a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WPAuthError (WPAuthorization a) -> m (WPAuthorization a))
-> (ExceptT WPAuthError m (WPAuthorization a)
    -> m (Either WPAuthError (WPAuthorization a)))
-> ExceptT WPAuthError m (WPAuthorization a)
-> m (WPAuthorization a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ExceptT WPAuthError m (WPAuthorization a)
-> m (Either WPAuthError (WPAuthorization a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT WPAuthError m (WPAuthorization a)
 -> m (WPAuthorization a))
-> ExceptT WPAuthError m (WPAuthorization a)
-> m (WPAuthorization a)
forall a b. (a -> b) -> a -> b
$ do
        CookieName
name        <- m CookieName -> ExceptT WPAuthError m CookieName
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CookieName -> ExceptT WPAuthError m CookieName)
-> m CookieName -> ExceptT WPAuthError m CookieName
forall a b. (a -> b) -> a -> b
$ WPAuthConfig m a -> m CookieName
forall (m :: * -> *) a. WPAuthConfig m a -> m CookieName
getCookieName WPAuthConfig m a
cfg
        POSIXTime
currentTime <- IO POSIXTime -> ExceptT WPAuthError m POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
        (CookieHeaderError -> ExceptT WPAuthError m (WPAuthorization a))
-> (Text -> ExceptT WPAuthError m (WPAuthorization a))
-> Either CookieHeaderError Text
-> ExceptT WPAuthError m (WPAuthorization a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ExceptT WPAuthError m (WPAuthorization a)
-> CookieHeaderError -> ExceptT WPAuthError m (WPAuthorization a)
forall a b. a -> b -> a
const (ExceptT WPAuthError m (WPAuthorization a)
 -> CookieHeaderError -> ExceptT WPAuthError m (WPAuthorization a))
-> ExceptT WPAuthError m (WPAuthorization a)
-> CookieHeaderError
-> ExceptT WPAuthError m (WPAuthorization a)
forall a b. (a -> b) -> a -> b
$ POSIXTime -> ExceptT WPAuthError m (WPAuthorization a)
validateAnonymousUser POSIXTime
currentTime)
               (POSIXTime -> Text -> ExceptT WPAuthError m (WPAuthorization a)
validateAuthorizedUser POSIXTime
currentTime)
            (Either CookieHeaderError Text
 -> ExceptT WPAuthError m (WPAuthorization a))
-> Either CookieHeaderError Text
-> ExceptT WPAuthError m (WPAuthorization a)
forall a b. (a -> b) -> a -> b
$ CookieName -> RequestHeaders -> Either CookieHeaderError Text
findCookie CookieName
name RequestHeaders
headers
  where
    validateAnonymousUser
        :: POSIXTime -> ExceptT WPAuthError m (WPAuthorization a)
    validateAnonymousUser :: POSIXTime -> ExceptT WPAuthError m (WPAuthorization a)
validateAnonymousUser POSIXTime
currentTime =
        POSIXTime
-> Maybe CookieToken
-> Maybe WordpressUserId
-> ExceptT WPAuthError m ()
checkNonce POSIXTime
currentTime Maybe CookieToken
forall a. Maybe a
Nothing Maybe WordpressUserId
forall a. Maybe a
Nothing ExceptT WPAuthError m ()
-> ExceptT WPAuthError m (WPAuthorization a)
-> ExceptT WPAuthError m (WPAuthorization a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WPAuthorization a -> ExceptT WPAuthError m (WPAuthorization a)
forall (m :: * -> *) a. Monad m => a -> m a
return WPAuthorization a
forall a. WPAuthorization a
WPAnonymousUser

    validateAuthorizedUser
        :: POSIXTime -> Text -> ExceptT WPAuthError m (WPAuthorization a)
    validateAuthorizedUser :: POSIXTime -> Text -> ExceptT WPAuthError m (WPAuthorization a)
validateAuthorizedUser POSIXTime
currentTime Text
rawCookie = do
        WPCookie
parsedCookie <- (CookieParseError -> WPAuthError)
-> Either CookieParseError WPCookie
-> ExceptT WPAuthError m WPCookie
forall e2 e1 b. (e2 -> e1) -> Either e2 b -> ExceptT e1 m b
liftWith CookieParseError -> WPAuthError
EParse (Either CookieParseError WPCookie
 -> ExceptT WPAuthError m WPCookie)
-> Either CookieParseError WPCookie
-> ExceptT WPAuthError m WPCookie
forall a b. (a -> b) -> a -> b
$ Text -> Either CookieParseError WPCookie
parseWordpressCookie Text
rawCookie
        UserAuthData { a
userData :: forall a. UserAuthData a -> a
userData :: a
userData, WordpressUserId
wpUser :: forall a. UserAuthData a -> WordpressUserId
wpUser :: WordpressUserId
wpUser, WordpressUserPass
wpPass :: forall a. UserAuthData a -> WordpressUserPass
wpPass :: WordpressUserPass
wpPass, [SessionToken]
wpTokens :: forall a. UserAuthData a -> [SessionToken]
wpTokens :: [SessionToken]
wpTokens } <-
            m (Maybe (UserAuthData a))
-> ExceptT WPAuthError m (Maybe (UserAuthData a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WPAuthConfig m a -> Text -> m (Maybe (UserAuthData a))
forall (m :: * -> *) a.
WPAuthConfig m a -> Text -> m (Maybe (UserAuthData a))
getUserData WPAuthConfig m a
cfg (Text -> m (Maybe (UserAuthData a)))
-> Text -> m (Maybe (UserAuthData a))
forall a b. (a -> b) -> a -> b
$ WPCookie -> Text
username WPCookie
parsedCookie)
                ExceptT WPAuthError m (Maybe (UserAuthData a))
-> (Maybe (UserAuthData a)
    -> ExceptT WPAuthError m (UserAuthData a))
-> ExceptT WPAuthError m (UserAuthData a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WPAuthError
-> Maybe (UserAuthData a) -> ExceptT WPAuthError m (UserAuthData a)
forall e b. e -> Maybe b -> ExceptT e m b
liftMaybe WPAuthError
UserDataNotFound
        ExceptT WPAuthError m () -> ExceptT WPAuthError m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT WPAuthError m () -> ExceptT WPAuthError m ())
-> (Either CookieValidationError () -> ExceptT WPAuthError m ())
-> Either CookieValidationError ()
-> ExceptT WPAuthError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CookieValidationError -> WPAuthError)
-> Either CookieValidationError () -> ExceptT WPAuthError m ()
forall e2 e1 b. (e2 -> e1) -> Either e2 b -> ExceptT e1 m b
liftWith CookieValidationError -> WPAuthError
EValid (Either CookieValidationError () -> ExceptT WPAuthError m ())
-> Either CookieValidationError () -> ExceptT WPAuthError m ()
forall a b. (a -> b) -> a -> b
$ AuthScheme
-> POSIXTime
-> WPCookie
-> WordpressUserPass
-> [SessionToken]
-> Either CookieValidationError ()
validateCookie (WPAuthConfig m a -> AuthScheme
forall (m :: * -> *) a. WPAuthConfig m a -> AuthScheme
loggedInScheme WPAuthConfig m a
cfg)
                                                POSIXTime
currentTime
                                                WPCookie
parsedCookie
                                                WordpressUserPass
wpPass
                                                [SessionToken]
wpTokens
        POSIXTime
-> Maybe CookieToken
-> Maybe WordpressUserId
-> ExceptT WPAuthError m ()
checkNonce POSIXTime
currentTime (CookieToken -> Maybe CookieToken
forall a. a -> Maybe a
Just (CookieToken -> Maybe CookieToken)
-> CookieToken -> Maybe CookieToken
forall a b. (a -> b) -> a -> b
$ WPCookie -> CookieToken
token WPCookie
parsedCookie) (WordpressUserId -> Maybe WordpressUserId
forall a. a -> Maybe a
Just WordpressUserId
wpUser)
        WPAuthorization a -> ExceptT WPAuthError m (WPAuthorization a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WPAuthorization a -> ExceptT WPAuthError m (WPAuthorization a))
-> WPAuthorization a -> ExceptT WPAuthError m (WPAuthorization a)
forall a b. (a -> b) -> a -> b
$ a -> WPAuthorization a
forall a. a -> WPAuthorization a
WPAuthorizedUser a
userData

    checkNonce
        :: POSIXTime
        -> Maybe CookieToken
        -> Maybe WordpressUserId
        -> ExceptT WPAuthError m ()
    checkNonce :: POSIXTime
-> Maybe CookieToken
-> Maybe WordpressUserId
-> ExceptT WPAuthError m ()
checkNonce POSIXTime
time Maybe CookieToken
mToken Maybe WordpressUserId
mUser = do
        Text
nonce <- WPAuthError -> Maybe Text -> ExceptT WPAuthError m Text
forall e b. e -> Maybe b -> ExceptT e m b
liftMaybe WPAuthError
NoNonce (Maybe Text -> ExceptT WPAuthError m Text)
-> Maybe Text -> ExceptT WPAuthError m Text
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> [QueryItem] -> Maybe Text
findNonce RequestHeaders
headers [QueryItem]
query
        let nonceTick :: NonceTick
nonceTick    = POSIXTime -> POSIXTime -> NonceTick
wordpressNonceTick (WPAuthConfig m a -> POSIXTime
forall (m :: * -> *) a. WPAuthConfig m a -> POSIXTime
nonceLifetime WPAuthConfig m a
cfg) POSIXTime
time
            nonceIsValid :: Bool
nonceIsValid = AuthScheme
-> Maybe CookieToken
-> NonceTick
-> Maybe WordpressUserId
-> Text
-> Text
-> Bool
validateNonce (WPAuthConfig m a -> AuthScheme
forall (m :: * -> *) a. WPAuthConfig m a -> AuthScheme
nonceScheme WPAuthConfig m a
cfg)
                                         Maybe CookieToken
mToken
                                         NonceTick
nonceTick
                                         Maybe WordpressUserId
mUser
                                         Text
"wp_rest"
                                         Text
nonce
        Bool -> ExceptT WPAuthError m () -> ExceptT WPAuthError m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nonceIsValid (ExceptT WPAuthError m () -> ExceptT WPAuthError m ())
-> ExceptT WPAuthError m () -> ExceptT WPAuthError m ()
forall a b. (a -> b) -> a -> b
$ WPAuthError -> ExceptT WPAuthError m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError WPAuthError
InvalidNonce

    liftMaybe :: e -> Maybe b -> ExceptT e m b
    liftMaybe :: e -> Maybe b -> ExceptT e m b
liftMaybe e
e Maybe b
m = Either e b -> ExceptT e m b
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either e b -> ExceptT e m b) -> Either e b -> ExceptT e m b
forall a b. (a -> b) -> a -> b
$ Either e b -> (b -> Either e b) -> Maybe b -> Either e b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e b
forall a b. a -> Either a b
Left e
e) b -> Either e b
forall a b. b -> Either a b
Right Maybe b
m

    liftWith :: (e2 -> e1) -> Either e2 b -> ExceptT e1 m b
    liftWith :: (e2 -> e1) -> Either e2 b -> ExceptT e1 m b
liftWith e2 -> e1
e = (e2 -> e1) -> ExceptT e2 m b -> ExceptT e1 m b
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT e2 -> e1
e (ExceptT e2 m b -> ExceptT e1 m b)
-> (Either e2 b -> ExceptT e2 m b) -> Either e2 b -> ExceptT e1 m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e2 b -> ExceptT e2 m b
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither

-- | The result of the 'authorizeWordpressRequest' function can be an
-- authorized user with some additional data, or an anonymous user.
data WPAuthorization a
    = WPAuthorizedUser a
    | WPAnonymousUser
    deriving (Int -> WPAuthorization a -> ShowS
[WPAuthorization a] -> ShowS
WPAuthorization a -> String
(Int -> WPAuthorization a -> ShowS)
-> (WPAuthorization a -> String)
-> ([WPAuthorization a] -> ShowS)
-> Show (WPAuthorization a)
forall a. Show a => Int -> WPAuthorization a -> ShowS
forall a. Show a => [WPAuthorization a] -> ShowS
forall a. Show a => WPAuthorization a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WPAuthorization a] -> ShowS
$cshowList :: forall a. Show a => [WPAuthorization a] -> ShowS
show :: WPAuthorization a -> String
$cshow :: forall a. Show a => WPAuthorization a -> String
showsPrec :: Int -> WPAuthorization a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WPAuthorization a -> ShowS
Show, WPAuthorization a -> WPAuthorization a -> Bool
(WPAuthorization a -> WPAuthorization a -> Bool)
-> (WPAuthorization a -> WPAuthorization a -> Bool)
-> Eq (WPAuthorization a)
forall a. Eq a => WPAuthorization a -> WPAuthorization a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WPAuthorization a -> WPAuthorization a -> Bool
$c/= :: forall a. Eq a => WPAuthorization a -> WPAuthorization a -> Bool
== :: WPAuthorization a -> WPAuthorization a -> Bool
$c== :: forall a. Eq a => WPAuthorization a -> WPAuthorization a -> Bool
Eq)

-- | Configuration data specific to your Wordpress site & Haskell
-- application.
data WPAuthConfig m a
    = WPAuthConfig
        { WPAuthConfig m a -> m CookieName
getCookieName :: m CookieName
        -- ^ A monadic action that generates a `CookieName`. You can simply
        -- return a constant value, or do something more complex like
        -- querying your database for the @siteurl@ option.
        , WPAuthConfig m a -> AuthScheme
loggedInScheme :: AuthScheme
        -- ^ The @LOGGED_IN_KEY@ & @LOGGED_IN_SALT@ from your
        -- @wp-config.php@.
        , WPAuthConfig m a -> AuthScheme
nonceScheme :: AuthScheme
        -- ^ The @NONCE_KEY@ & @NONCE_SALT@ from your @wp-config.php@.
        , WPAuthConfig m a -> POSIXTime
nonceLifetime :: NominalDiffTime
        -- ^ The nonce lifetime of your Wordpress site. Wordpress defaults
        -- to 1 day.
        , WPAuthConfig m a -> Text -> m (Maybe (UserAuthData a))
getUserData :: Text -> m (Maybe (UserAuthData a))
        -- ^ A function to pull your custom data & the user data needed for
        -- authentication. See the 'UserAuthData' type.
        , WPAuthConfig m a -> WPAuthError -> m (WPAuthorization a)
onAuthenticationFailure :: WPAuthError -> m (WPAuthorization a)
        -- ^ How to handle authentication failures. You might want to throw
        -- an HTTP error or simply treat the user as unauthenticated.
        }

-- | The data needed for authentication, along with some arbitrary data
-- that is returned on success.
data UserAuthData a =
    UserAuthData
        { UserAuthData a -> a
userData :: a
        -- ^ Arbitrary data that the validation should return. E.g., if you
        -- query your users table for the @ID@ & @user_pass@, you can
        -- return your whole User type so you don't have to make another
        -- database call in your handler.
        , UserAuthData a -> WordpressUserId
wpUser :: WordpressUserId
        -- ^ The @ID@ field of the User.
        , UserAuthData a -> WordpressUserPass
wpPass :: WordpressUserPass
        -- ^ The @user_pass@ field of the User.
        , UserAuthData a -> [SessionToken]
wpTokens :: [SessionToken]
        -- ^ The @session_tokens@ usermeta for the User. You can use
        -- 'Wordpress.Auth.decodeSessionTokens' to parse the raw meta value.
        }
    deriving (Int -> UserAuthData a -> ShowS
[UserAuthData a] -> ShowS
UserAuthData a -> String
(Int -> UserAuthData a -> ShowS)
-> (UserAuthData a -> String)
-> ([UserAuthData a] -> ShowS)
-> Show (UserAuthData a)
forall a. Show a => Int -> UserAuthData a -> ShowS
forall a. Show a => [UserAuthData a] -> ShowS
forall a. Show a => UserAuthData a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserAuthData a] -> ShowS
$cshowList :: forall a. Show a => [UserAuthData a] -> ShowS
show :: UserAuthData a -> String
$cshow :: forall a. Show a => UserAuthData a -> String
showsPrec :: Int -> UserAuthData a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> UserAuthData a -> ShowS
Show, UserAuthData a -> UserAuthData a -> Bool
(UserAuthData a -> UserAuthData a -> Bool)
-> (UserAuthData a -> UserAuthData a -> Bool)
-> Eq (UserAuthData a)
forall a. Eq a => UserAuthData a -> UserAuthData a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserAuthData a -> UserAuthData a -> Bool
$c/= :: forall a. Eq a => UserAuthData a -> UserAuthData a -> Bool
== :: UserAuthData a -> UserAuthData a -> Bool
$c== :: forall a. Eq a => UserAuthData a -> UserAuthData a -> Bool
Eq)

-- | Potential errors during authentication.
data WPAuthError
    = EHeader CookieHeaderError
    -- ^ Header Error.
    | EParse CookieParseError
    -- ^ Parsing Error.
    | EValid CookieValidationError
    -- ^ Validation Error.
    | UserDataNotFound
    -- ^ The `getUserData` function returned `Nothing`.
    | NoNonce
    -- ^ The @Request@ has no @X-WP-Nonce@ header.
    | InvalidNonce
    -- ^ The nonce couldn't be validated.
    deriving (Int -> WPAuthError -> ShowS
[WPAuthError] -> ShowS
WPAuthError -> String
(Int -> WPAuthError -> ShowS)
-> (WPAuthError -> String)
-> ([WPAuthError] -> ShowS)
-> Show WPAuthError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WPAuthError] -> ShowS
$cshowList :: [WPAuthError] -> ShowS
show :: WPAuthError -> String
$cshow :: WPAuthError -> String
showsPrec :: Int -> WPAuthError -> ShowS
$cshowsPrec :: Int -> WPAuthError -> ShowS
Show, WPAuthError -> WPAuthError -> Bool
(WPAuthError -> WPAuthError -> Bool)
-> (WPAuthError -> WPAuthError -> Bool) -> Eq WPAuthError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WPAuthError -> WPAuthError -> Bool
$c/= :: WPAuthError -> WPAuthError -> Bool
== :: WPAuthError -> WPAuthError -> Bool
$c== :: WPAuthError -> WPAuthError -> Bool
Eq)


-- | The name of a Wordpress authentication cookie. Wordpress's frontend
-- uses @CookieNameWithMD5 "wordpress_logged_in_" "\<your-site-url>"@ by
-- default.
data CookieName
    = CustomCookieName Text
    -- ^ A constant name for the cookie.
    | CookieNameWithMD5 Text Text
    -- ^ A cookie name with some text to hash & append. E.g., Wordpress's
    -- @logged_in@ auth scheme uses @wordpress_logged_in_@ suffixed with
    -- the MD5 hash of the @siteurl@ option.
    deriving (Int -> CookieName -> ShowS
[CookieName] -> ShowS
CookieName -> String
(Int -> CookieName -> ShowS)
-> (CookieName -> String)
-> ([CookieName] -> ShowS)
-> Show CookieName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieName] -> ShowS
$cshowList :: [CookieName] -> ShowS
show :: CookieName -> String
$cshow :: CookieName -> String
showsPrec :: Int -> CookieName -> ShowS
$cshowsPrec :: Int -> CookieName -> ShowS
Show, CookieName -> CookieName -> Bool
(CookieName -> CookieName -> Bool)
-> (CookieName -> CookieName -> Bool) -> Eq CookieName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieName -> CookieName -> Bool
$c/= :: CookieName -> CookieName -> Bool
== :: CookieName -> CookieName -> Bool
$c== :: CookieName -> CookieName -> Bool
Eq)

-- | Build the name of an authentication cookie from a `CookieName`,
-- hashing the suffix if present.
cookieName :: CookieName -> Text
cookieName :: CookieName -> Text
cookieName = \case
    CustomCookieName Text
n -> Text
n
    CookieNameWithMD5 Text
name Text
textToHash ->
        Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString) -> HashMessage -> Text
hashText ByteString -> ByteString
MD5.hash (Text -> HashMessage
HashMessage Text
textToHash)

-- | Try to find & decode a Cookie in the headers with the given name.
findCookie :: CookieName -> RequestHeaders -> Either CookieHeaderError Text
findCookie :: CookieName -> RequestHeaders -> Either CookieHeaderError Text
findCookie CookieName
name RequestHeaders
headers = do
    ByteString
header <- CookieHeaderError
-> Maybe ByteString -> Either CookieHeaderError ByteString
forall a b. a -> Maybe b -> Either a b
liftMaybe CookieHeaderError
NoCookieHeader (Maybe ByteString -> Either CookieHeaderError ByteString)
-> Maybe ByteString -> Either CookieHeaderError ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"cookie" RequestHeaders
headers
    let cookieBody :: CookiesText
cookieBody = ByteString -> CookiesText
parseCookiesText ByteString
header
        authCookie :: Maybe Text
authCookie = Text -> Text
URI.decodeText (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CookiesText -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CookieName -> Text
cookieName CookieName
name) CookiesText
cookieBody
    CookieHeaderError -> Maybe Text -> Either CookieHeaderError Text
forall a b. a -> Maybe b -> Either a b
liftMaybe CookieHeaderError
NoCookieMatches Maybe Text
authCookie
    where liftMaybe :: a -> Maybe b -> Either a b
liftMaybe a
e = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
e) b -> Either a b
forall a b. b -> Either a b
Right

-- | Potential errors while searching for a specific cookie in the request
-- headers.
data CookieHeaderError
    = NoCookieHeader
    -- ^ The Request has no @Cookie@ header.
    | NoCookieMatches
    -- ^ No Cookie matched the expected `CookieName`.
    deriving (Int -> CookieHeaderError -> ShowS
[CookieHeaderError] -> ShowS
CookieHeaderError -> String
(Int -> CookieHeaderError -> ShowS)
-> (CookieHeaderError -> String)
-> ([CookieHeaderError] -> ShowS)
-> Show CookieHeaderError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieHeaderError] -> ShowS
$cshowList :: [CookieHeaderError] -> ShowS
show :: CookieHeaderError -> String
$cshow :: CookieHeaderError -> String
showsPrec :: Int -> CookieHeaderError -> ShowS
$cshowsPrec :: Int -> CookieHeaderError -> ShowS
Show, CookieHeaderError -> CookieHeaderError -> Bool
(CookieHeaderError -> CookieHeaderError -> Bool)
-> (CookieHeaderError -> CookieHeaderError -> Bool)
-> Eq CookieHeaderError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieHeaderError -> CookieHeaderError -> Bool
$c/= :: CookieHeaderError -> CookieHeaderError -> Bool
== :: CookieHeaderError -> CookieHeaderError -> Bool
$c== :: CookieHeaderError -> CookieHeaderError -> Bool
Eq)

-- | Try to find & decode a Nonce in either the @X-WP-Nonce@ header or the
-- @_wpnonce@ query parameter.
findNonce :: RequestHeaders -> [QueryItem] -> Maybe Text
findNonce :: RequestHeaders -> [QueryItem] -> Maybe Text
findNonce RequestHeaders
headers [QueryItem]
query =
    (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Maybe ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"x-wp-nonce" RequestHeaders
headers Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
        (ByteString -> [QueryItem] -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"_wpnonce" [QueryItem]
query)


-- Cookies

-- | This represents a Cookie set by a Wordpress authentication scheme
-- (@auth@, @auth_sec@, & @logged_in@).
data WPCookie
    = WPCookie
        { WPCookie -> Text
username :: Text
        -- ^ The @user_login@ column for the Wordpress User.
        , WPCookie -> POSIXTime
expiration :: POSIXTime
        -- ^ The expiration time of the Cookie.
        , WPCookie -> CookieToken
token :: CookieToken
        -- ^ The Wordpress User's session token.
        , WPCookie -> Text
hmac :: Text
        -- ^ A SHA256 HMAC hash of the token & some user data.
        }
    deriving (Int -> WPCookie -> ShowS
[WPCookie] -> ShowS
WPCookie -> String
(Int -> WPCookie -> ShowS)
-> (WPCookie -> String) -> ([WPCookie] -> ShowS) -> Show WPCookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WPCookie] -> ShowS
$cshowList :: [WPCookie] -> ShowS
show :: WPCookie -> String
$cshow :: WPCookie -> String
showsPrec :: Int -> WPCookie -> ShowS
$cshowsPrec :: Int -> WPCookie -> ShowS
Show, WPCookie -> WPCookie -> Bool
(WPCookie -> WPCookie -> Bool)
-> (WPCookie -> WPCookie -> Bool) -> Eq WPCookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WPCookie -> WPCookie -> Bool
$c/= :: WPCookie -> WPCookie -> Bool
== :: WPCookie -> WPCookie -> Bool
$c== :: WPCookie -> WPCookie -> Bool
Eq)

-- | A User's Wordpress Session Token from an auth cookie.
newtype CookieToken
    = CookieToken { CookieToken -> Text
cookieToken :: Text }
    deriving (Int -> CookieToken -> ShowS
[CookieToken] -> ShowS
CookieToken -> String
(Int -> CookieToken -> ShowS)
-> (CookieToken -> String)
-> ([CookieToken] -> ShowS)
-> Show CookieToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieToken] -> ShowS
$cshowList :: [CookieToken] -> ShowS
show :: CookieToken -> String
$cshow :: CookieToken -> String
showsPrec :: Int -> CookieToken -> ShowS
$cshowsPrec :: Int -> CookieToken -> ShowS
Show, CookieToken -> CookieToken -> Bool
(CookieToken -> CookieToken -> Bool)
-> (CookieToken -> CookieToken -> Bool) -> Eq CookieToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieToken -> CookieToken -> Bool
$c/= :: CookieToken -> CookieToken -> Bool
== :: CookieToken -> CookieToken -> Bool
$c== :: CookieToken -> CookieToken -> Bool
Eq)

-- | Potential errors we may encounter while parsing a `WPCookie`.
data CookieParseError
    = MalformedCookie
    -- ^ The cookie did not have 4 fields separated by @|@ characters.
    | InvalidExpiration
    -- ^ The `expiration` field of the cookie is not an Integer.
    deriving (Int -> CookieParseError -> ShowS
[CookieParseError] -> ShowS
CookieParseError -> String
(Int -> CookieParseError -> ShowS)
-> (CookieParseError -> String)
-> ([CookieParseError] -> ShowS)
-> Show CookieParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieParseError] -> ShowS
$cshowList :: [CookieParseError] -> ShowS
show :: CookieParseError -> String
$cshow :: CookieParseError -> String
showsPrec :: Int -> CookieParseError -> ShowS
$cshowsPrec :: Int -> CookieParseError -> ShowS
Show, CookieParseError -> CookieParseError -> Bool
(CookieParseError -> CookieParseError -> Bool)
-> (CookieParseError -> CookieParseError -> Bool)
-> Eq CookieParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieParseError -> CookieParseError -> Bool
$c/= :: CookieParseError -> CookieParseError -> Bool
== :: CookieParseError -> CookieParseError -> Bool
$c== :: CookieParseError -> CookieParseError -> Bool
Eq)

-- | Parse a `WPCookie` from the body text of an @auth@, @auth_sec@, or
-- @logged_in@ cookie.
parseWordpressCookie :: Text -> Either CookieParseError WPCookie
parseWordpressCookie :: Text -> Either CookieParseError WPCookie
parseWordpressCookie Text
rawCookie = case Text -> Text -> [Text]
T.splitOn Text
"|" Text
rawCookie of
    [Text
username, Text
expiration_, Text
token_, Text
hmac] ->
        let token :: CookieToken
token = Text -> CookieToken
CookieToken Text
token_
        in  case Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> POSIXTime) -> Maybe Integer -> Maybe POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
expiration_) of
                Just POSIXTime
expiration -> WPCookie -> Either CookieParseError WPCookie
forall a b. b -> Either a b
Right WPCookie :: Text -> POSIXTime -> CookieToken -> Text -> WPCookie
WPCookie { Text
POSIXTime
CookieToken
expiration :: POSIXTime
token :: CookieToken
hmac :: Text
username :: Text
hmac :: Text
expiration :: POSIXTime
token :: CookieToken
username :: Text
.. }
                Maybe POSIXTime
Nothing         -> CookieParseError -> Either CookieParseError WPCookie
forall a b. a -> Either a b
Left CookieParseError
InvalidExpiration
    [Text]
_ -> CookieParseError -> Either CookieParseError WPCookie
forall a b. a -> Either a b
Left CookieParseError
MalformedCookie

-- | The @ID@ field from the @users@ table of a Wordpress site.
newtype WordpressUserId
    = WordpressUserId { WordpressUserId -> Integer
wordpressUserId :: Integer }
    deriving (Int -> WordpressUserId -> ShowS
[WordpressUserId] -> ShowS
WordpressUserId -> String
(Int -> WordpressUserId -> ShowS)
-> (WordpressUserId -> String)
-> ([WordpressUserId] -> ShowS)
-> Show WordpressUserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordpressUserId] -> ShowS
$cshowList :: [WordpressUserId] -> ShowS
show :: WordpressUserId -> String
$cshow :: WordpressUserId -> String
showsPrec :: Int -> WordpressUserId -> ShowS
$cshowsPrec :: Int -> WordpressUserId -> ShowS
Show, WordpressUserId -> WordpressUserId -> Bool
(WordpressUserId -> WordpressUserId -> Bool)
-> (WordpressUserId -> WordpressUserId -> Bool)
-> Eq WordpressUserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordpressUserId -> WordpressUserId -> Bool
$c/= :: WordpressUserId -> WordpressUserId -> Bool
== :: WordpressUserId -> WordpressUserId -> Bool
$c== :: WordpressUserId -> WordpressUserId -> Bool
Eq)

-- | The @user_pass@ field from the @users@ table of a Wordpress site.
newtype WordpressUserPass
    = WordpressUserPass { WordpressUserPass -> Text
wordpressUserPass :: Text }
    deriving (Int -> WordpressUserPass -> ShowS
[WordpressUserPass] -> ShowS
WordpressUserPass -> String
(Int -> WordpressUserPass -> ShowS)
-> (WordpressUserPass -> String)
-> ([WordpressUserPass] -> ShowS)
-> Show WordpressUserPass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordpressUserPass] -> ShowS
$cshowList :: [WordpressUserPass] -> ShowS
show :: WordpressUserPass -> String
$cshow :: WordpressUserPass -> String
showsPrec :: Int -> WordpressUserPass -> ShowS
$cshowsPrec :: Int -> WordpressUserPass -> ShowS
Show, WordpressUserPass -> WordpressUserPass -> Bool
(WordpressUserPass -> WordpressUserPass -> Bool)
-> (WordpressUserPass -> WordpressUserPass -> Bool)
-> Eq WordpressUserPass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordpressUserPass -> WordpressUserPass -> Bool
$c/= :: WordpressUserPass -> WordpressUserPass -> Bool
== :: WordpressUserPass -> WordpressUserPass -> Bool
$c== :: WordpressUserPass -> WordpressUserPass -> Bool
Eq)

-- | Determine if a `WPCookie`'s hash matches the hashed password & token.
--
-- A secret is generated by hashing the user, password, expiration, & token.
-- This secret is then used to hash the user, expiration, & token. The
-- resulting hash should match the `hmac` hash in the `WPCookie`.
validateCookieHash :: AuthScheme -> WPCookie -> WordpressUserPass -> Bool
validateCookieHash :: AuthScheme -> WPCookie -> WordpressUserPass -> Bool
validateCookieHash AuthScheme
scheme WPCookie
cookie WordpressUserPass
userPass =
    let
        passwordFragment :: Text
passwordFragment = Int -> Text -> Text
T.take Int
4 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
8 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ WordpressUserPass -> Text
wordpressUserPass WordpressUserPass
userPass
        user :: Text
user             = WPCookie -> Text
username WPCookie
cookie
        tok :: Text
tok              = CookieToken -> Text
cookieToken (CookieToken -> Text) -> CookieToken -> Text
forall a b. (a -> b) -> a -> b
$ WPCookie -> CookieToken
token WPCookie
cookie
        secret :: Text
secret           = AuthScheme -> Text -> Text
wordpressHash AuthScheme
scheme (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinHashParts
            [Text
user, Text
passwordFragment, POSIXTime -> Text
posixText (POSIXTime -> Text) -> POSIXTime -> Text
forall a b. (a -> b) -> a -> b
$ WPCookie -> POSIXTime
expiration WPCookie
cookie, Text
tok]
        hash :: Text
hash =
            (ByteString -> ByteString -> ByteString)
-> HashSecret -> HashMessage -> Text
hmacText ByteString -> ByteString -> ByteString
SHA256.hmac (Text -> HashSecret
HashSecret Text
secret)
                (HashMessage -> Text) -> HashMessage -> Text
forall a b. (a -> b) -> a -> b
$ Text -> HashMessage
HashMessage
                (Text -> HashMessage) -> Text -> HashMessage
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinHashParts [Text
user, POSIXTime -> Text
posixText (POSIXTime -> Text) -> POSIXTime -> Text
forall a b. (a -> b) -> a -> b
$ WPCookie -> POSIXTime
expiration WPCookie
cookie, Text
tok]
    in
        Text
hash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== WPCookie -> Text
hmac WPCookie
cookie
  where
    posixText :: POSIXTime -> Text
    posixText :: POSIXTime -> Text
posixText POSIXTime
t = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor POSIXTime
t :: Integer)

-- | Validate a Wordpress Authentication Cookie by verifying that the hash
-- & token in the cookie are valid and the expiration time is in the
-- future.
validateCookie
    :: AuthScheme -- ^ They @_KEY@ & @_SALT@ constants for a WP auth scheme.
    -> POSIXTime -- ^ The current time.
    -> WPCookie -- ^ The cookie to validate.
    -> WordpressUserPass -- ^ The @user_pass@ field for the cookie's user.
    -> [SessionToken] -- ^ The @session_tokens@ meta for the cookie's user.
    -> Either CookieValidationError ()
validateCookie :: AuthScheme
-> POSIXTime
-> WPCookie
-> WordpressUserPass
-> [SessionToken]
-> Either CookieValidationError ()
validateCookie AuthScheme
scheme POSIXTime
currentTime WPCookie
cookie WordpressUserPass
userPass [SessionToken]
sessionTokens =
    let validHash :: Bool
validHash = AuthScheme -> WPCookie -> WordpressUserPass -> Bool
validateCookieHash AuthScheme
scheme WPCookie
cookie WordpressUserPass
userPass
        validSessionToken :: Bool
validSessionToken =
                POSIXTime -> CookieToken -> [SessionToken] -> Bool
validateSessionToken POSIXTime
currentTime (WPCookie -> CookieToken
token WPCookie
cookie) [SessionToken]
sessionTokens
    in  if POSIXTime
currentTime POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> WPCookie -> POSIXTime
expiration WPCookie
cookie
            then CookieValidationError -> Either CookieValidationError ()
forall a b. a -> Either a b
Left CookieValidationError
CookieExpired
            else case (Bool
validHash, Bool
validSessionToken) of
                (Bool
False, Bool
_    ) -> CookieValidationError -> Either CookieValidationError ()
forall a b. a -> Either a b
Left CookieValidationError
InvalidHash
                (Bool
_    , Bool
False) -> CookieValidationError -> Either CookieValidationError ()
forall a b. a -> Either a b
Left CookieValidationError
InvalidToken
                (Bool
True , Bool
True ) -> () -> Either CookieValidationError ()
forall a b. b -> Either a b
Right ()


-- | Potential validation errors for a `WPCookie`.
data CookieValidationError
    = CookieExpired
    -- ^ The `expiration` time of the cookie is in the past.
    | InvalidHash
    -- ^ The `hmac` hash in the cookie doesn't match the calculated hash.
    | InvalidToken
    -- ^ The `token` in the cookie is not valid or expired.
    deriving (Int -> CookieValidationError -> ShowS
[CookieValidationError] -> ShowS
CookieValidationError -> String
(Int -> CookieValidationError -> ShowS)
-> (CookieValidationError -> String)
-> ([CookieValidationError] -> ShowS)
-> Show CookieValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieValidationError] -> ShowS
$cshowList :: [CookieValidationError] -> ShowS
show :: CookieValidationError -> String
$cshow :: CookieValidationError -> String
showsPrec :: Int -> CookieValidationError -> ShowS
$cshowsPrec :: Int -> CookieValidationError -> ShowS
Show, CookieValidationError -> CookieValidationError -> Bool
(CookieValidationError -> CookieValidationError -> Bool)
-> (CookieValidationError -> CookieValidationError -> Bool)
-> Eq CookieValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieValidationError -> CookieValidationError -> Bool
$c/= :: CookieValidationError -> CookieValidationError -> Bool
== :: CookieValidationError -> CookieValidationError -> Bool
$c== :: CookieValidationError -> CookieValidationError -> Bool
Eq)




-- Hashing / Salting

-- | A port of the @wp_hash@ function. This performs an 'MD5.hmac' hash on
-- some text using a secret derived from the authentication scheme's key
-- & salt constants.
wordpressHash :: AuthScheme -> Text -> Text
wordpressHash :: AuthScheme -> Text -> Text
wordpressHash AuthScheme
scheme Text
textToHash =
    let secret :: HashSecret
secret = Text -> HashSecret
HashSecret (Text -> HashSecret) -> Text -> HashSecret
forall a b. (a -> b) -> a -> b
$ AuthScheme -> Text
wordpressSalt AuthScheme
scheme
    in  (ByteString -> ByteString -> ByteString)
-> HashSecret -> HashMessage -> Text
hmacText ByteString -> ByteString -> ByteString
MD5.hmac HashSecret
secret (HashMessage -> Text) -> HashMessage -> Text
forall a b. (a -> b) -> a -> b
$ Text -> HashMessage
HashMessage Text
textToHash

-- | A port of the @wp_salt@ function. Builds a secret key for a hashing
-- function using the auth scheme's key & salt.
wordpressSalt :: AuthScheme -> Text
wordpressSalt :: AuthScheme -> Text
wordpressSalt AuthScheme { WordpressKey
schemeKey :: AuthScheme -> WordpressKey
schemeKey :: WordpressKey
schemeKey, WordpressSalt
schemeSalt :: AuthScheme -> WordpressSalt
schemeSalt :: WordpressSalt
schemeSalt } =
    WordpressKey -> Text
unKey WordpressKey
schemeKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WordpressSalt -> Text
unSalt WordpressSalt
schemeSalt



-- Tokens

-- | 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.
data SessionToken
    = SessionToken
        { SessionToken -> Text
sessionToken :: Text
        , SessionToken -> POSIXTime
tokenExpiration :: POSIXTime
        }
    deriving (Int -> SessionToken -> ShowS
[SessionToken] -> ShowS
SessionToken -> String
(Int -> SessionToken -> ShowS)
-> (SessionToken -> String)
-> ([SessionToken] -> ShowS)
-> Show SessionToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionToken] -> ShowS
$cshowList :: [SessionToken] -> ShowS
show :: SessionToken -> String
$cshow :: SessionToken -> String
showsPrec :: Int -> SessionToken -> ShowS
$cshowsPrec :: Int -> SessionToken -> ShowS
Show, SessionToken -> SessionToken -> Bool
(SessionToken -> SessionToken -> Bool)
-> (SessionToken -> SessionToken -> Bool) -> Eq SessionToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionToken -> SessionToken -> Bool
$c/= :: SessionToken -> SessionToken -> Bool
== :: SessionToken -> SessionToken -> Bool
$c== :: SessionToken -> SessionToken -> Bool
Eq)

-- | 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,
-- >     // ...
-- >   ),
-- > );
decodeSessionTokens :: Text -> [SessionToken]
decodeSessionTokens :: Text -> [SessionToken]
decodeSessionTokens Text
serializedText =
    case ByteString -> Maybe PHPSessionValue
decodePHPSessionValue (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
serializedText) of
        Maybe PHPSessionValue
Nothing       -> []
        Just PHPSessionValue
phpValue -> PHPSessionValue -> [SessionToken]
decodeTokenArray PHPSessionValue
phpValue
  where
    decodeTokenArray :: PHPSessionValue -> [SessionToken]
    decodeTokenArray :: PHPSessionValue -> [SessionToken]
decodeTokenArray = \case
        PHPSessionValueArray [(PHPSessionValue, PHPSessionValue)]
sessionTokens ->
            ((PHPSessionValue, PHPSessionValue) -> Maybe SessionToken)
-> [(PHPSessionValue, PHPSessionValue)] -> [SessionToken]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PHPSessionValue, PHPSessionValue) -> Maybe SessionToken
decodeToken [(PHPSessionValue, PHPSessionValue)]
sessionTokens
        PHPSessionValue
_ -> []
    -- Decode a single Token, which can be a (token, expiration) pair, or
    -- an associative array.
    decodeToken :: (PHPSessionValue, PHPSessionValue) -> Maybe SessionToken
    decodeToken :: (PHPSessionValue, PHPSessionValue) -> Maybe SessionToken
decodeToken = \case
        (PHPSessionValueString ByteString
token, PHPSessionValue
expirationData) ->
            let decodedExpiration :: Maybe POSIXTime
decodedExpiration = case PHPSessionValue
expirationData of
                    PHPSessionValueInt Int
posixExpiration ->
                        POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> Maybe POSIXTime)
-> (Integer -> POSIXTime) -> Integer -> Maybe POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe POSIXTime) -> Integer -> Maybe POSIXTime
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posixExpiration
                    PHPSessionValueArray [(PHPSessionValue, PHPSessionValue)]
tokenData -> [(PHPSessionValue, PHPSessionValue)] -> Maybe POSIXTime
decodeTokenData [(PHPSessionValue, PHPSessionValue)]
tokenData
                    PHPSessionValue
_                              -> Maybe POSIXTime
forall a. Maybe a
Nothing
                sessionToken :: Text
sessionToken = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
token
            in  (\POSIXTime
tokenExpiration -> SessionToken :: Text -> POSIXTime -> SessionToken
SessionToken { Text
POSIXTime
tokenExpiration :: POSIXTime
sessionToken :: Text
tokenExpiration :: POSIXTime
sessionToken :: Text
.. }) (POSIXTime -> SessionToken)
-> Maybe POSIXTime -> Maybe SessionToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe POSIXTime
decodedExpiration

        (PHPSessionValue, PHPSessionValue)
_ -> Maybe SessionToken
forall a. Maybe a
Nothing
    -- Decode the sub-fields of a Token.
    decodeTokenData :: [(PHPSessionValue, PHPSessionValue)] -> Maybe POSIXTime
    decodeTokenData :: [(PHPSessionValue, PHPSessionValue)] -> Maybe POSIXTime
decodeTokenData = \case
        [] -> Maybe POSIXTime
forall a. Maybe a
Nothing
        (PHPSessionValueString ByteString
"expiration", PHPSessionValueInt Int
expiration) : [(PHPSessionValue, PHPSessionValue)]
_
            -> POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> Maybe POSIXTime) -> POSIXTime -> Maybe POSIXTime
forall a b. (a -> b) -> a -> b
$ Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> POSIXTime) -> Integer -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
expiration
        (PHPSessionValue, PHPSessionValue)
_ : [(PHPSessionValue, PHPSessionValue)]
rest -> [(PHPSessionValue, PHPSessionValue)] -> Maybe POSIXTime
decodeTokenData [(PHPSessionValue, PHPSessionValue)]
rest


-- | Determine if the SHA256 hash of the token matches one of the unexpired
-- session tokens.
validateSessionToken
    :: POSIXTime -- ^ The current time
    -> CookieToken -- ^ The session token from a `WPCookie`
    -> [SessionToken] -- ^ A list of the User's session tokens
    -> Bool
validateSessionToken :: POSIXTime -> CookieToken -> [SessionToken] -> Bool
validateSessionToken POSIXTime
currentTime (CookieToken Text
cookieToken) [SessionToken]
sessionTokens =
    let hashedCookieToken :: Text
hashedCookieToken = (ByteString -> ByteString) -> HashMessage -> Text
hashText ByteString -> ByteString
SHA256.hash (HashMessage -> Text) -> HashMessage -> Text
forall a b. (a -> b) -> a -> b
$ Text -> HashMessage
HashMessage Text
cookieToken
    in  Maybe SessionToken -> Bool
forall a. Maybe a -> Bool
isJust (Maybe SessionToken -> Bool) -> Maybe SessionToken -> Bool
forall a b. (a -> b) -> a -> b
$ (SessionToken -> Bool) -> [SessionToken] -> Maybe SessionToken
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
hashedCookieToken) (Text -> Bool) -> (SessionToken -> Text) -> SessionToken -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionToken -> Text
sessionToken) ([SessionToken] -> Maybe SessionToken)
-> [SessionToken] -> Maybe SessionToken
forall a b. (a -> b) -> a -> b
$ (SessionToken -> Bool) -> [SessionToken] -> [SessionToken]
forall a. (a -> Bool) -> [a] -> [a]
filter
            (\SessionToken
tok -> SessionToken -> POSIXTime
tokenExpiration SessionToken
tok POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
>= POSIXTime
currentTime)
            [SessionToken]
sessionTokens



-- Nonces

-- | The tick number of a Wordpress site - required for Nonce verification.
newtype NonceTick
    = NonceTick
        { NonceTick -> Integer
tickCount :: Integer
        }
    deriving (Int -> NonceTick -> ShowS
[NonceTick] -> ShowS
NonceTick -> String
(Int -> NonceTick -> ShowS)
-> (NonceTick -> String)
-> ([NonceTick] -> ShowS)
-> Show NonceTick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonceTick] -> ShowS
$cshowList :: [NonceTick] -> ShowS
show :: NonceTick -> String
$cshow :: NonceTick -> String
showsPrec :: Int -> NonceTick -> ShowS
$cshowsPrec :: Int -> NonceTick -> ShowS
Show, NonceTick -> NonceTick -> Bool
(NonceTick -> NonceTick -> Bool)
-> (NonceTick -> NonceTick -> Bool) -> Eq NonceTick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonceTick -> NonceTick -> Bool
$c/= :: NonceTick -> NonceTick -> Bool
== :: NonceTick -> NonceTick -> Bool
$c== :: NonceTick -> NonceTick -> Bool
Eq)

-- | A port of the @wp_nonce_tick@ function. Calculates the nonce tick
-- number, where each nonce has a lifetime of two ticks.
wordpressNonceTick
    :: NominalDiffTime -- ^ The nonce lifetime. Wordpress's default is 1 day.
    -> POSIXTime -- ^ The current time.
    -> NonceTick
wordpressNonceTick :: POSIXTime -> POSIXTime -> NonceTick
wordpressNonceTick POSIXTime
nonceLifetime POSIXTime
currentTime =
    let currentTick :: Rational
currentTick = POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational POSIXTime
currentTime Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational POSIXTime
nonceLifetime Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2)
    in  Integer -> NonceTick
NonceTick (Integer -> NonceTick) -> Integer -> NonceTick
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
currentTick

-- | Determine if the tick-dependent hash of the `CookieToken` matches the
-- hash of the current or previous tick.
validateNonce
    :: AuthScheme -- ^ The Wordpress site's @nonce@ scheme constants - @NONCE_KEY@ & @NONCE_SALT@.
    -> Maybe CookieToken -- ^ A token from the @logged_in@ cookie.
    -> NonceTick  -- ^ The current tick number.
    -> Maybe WordpressUserId -- ^ The ID of the currently logged in User.
    -> Text  -- ^ The @action@ of the nonce (e.g., @"wp_rest"@ for API requests).
    -> Text -- ^ The nonce to verify.
    -> Bool
validateNonce :: AuthScheme
-> Maybe CookieToken
-> NonceTick
-> Maybe WordpressUserId
-> Text
-> Text
-> Bool
validateNonce AuthScheme
scheme Maybe CookieToken
maybeToken NonceTick
tick Maybe WordpressUserId
maybeUserId Text
action Text
nonce =
    let
        userId :: Text
userId        = Text -> (WordpressUserId -> Text) -> Maybe WordpressUserId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (String -> Text
T.pack (String -> Text)
-> (WordpressUserId -> String) -> WordpressUserId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String)
-> (WordpressUserId -> Integer) -> WordpressUserId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordpressUserId -> Integer
wordpressUserId) Maybe WordpressUserId
maybeUserId
        token :: Text
token         = Text -> (CookieToken -> Text) -> Maybe CookieToken -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" CookieToken -> Text
cookieToken Maybe CookieToken
maybeToken
        thisCycleHash :: Text
thisCycleHash = Text -> Text
hashAndTrim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinHashParts
            [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ NonceTick -> Integer
tickCount NonceTick
tick, Text
action, Text
userId, Text
token]
        lastCycleHash :: Text
lastCycleHash = Text -> Text
hashAndTrim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinHashParts
            [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ NonceTick -> Integer
tickCount NonceTick
tick Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1, Text
action, Text
userId, Text
token]
    in
        Text
nonce Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&& Text
nonce Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
thisCycleHash, Text
lastCycleHash]
  where
    hashAndTrim :: Text -> Text
hashAndTrim Text
s =
        let hashed :: Text
hashed = AuthScheme -> Text -> Text
wordpressHash AuthScheme
scheme Text
s
        in  Int -> Text -> Text
T.take Int
10 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
hashed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) Text
hashed



-- Basic Types

-- | This represents one of the @$scheme@s 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.
--
data AuthScheme
    = AuthScheme
        { AuthScheme -> WordpressKey
schemeKey :: WordpressKey
        , AuthScheme -> WordpressSalt
schemeSalt :: WordpressSalt
        }
    deriving (Int -> AuthScheme -> ShowS
[AuthScheme] -> ShowS
AuthScheme -> String
(Int -> AuthScheme -> ShowS)
-> (AuthScheme -> String)
-> ([AuthScheme] -> ShowS)
-> Show AuthScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthScheme] -> ShowS
$cshowList :: [AuthScheme] -> ShowS
show :: AuthScheme -> String
$cshow :: AuthScheme -> String
showsPrec :: Int -> AuthScheme -> ShowS
$cshowsPrec :: Int -> AuthScheme -> ShowS
Show, AuthScheme -> AuthScheme -> Bool
(AuthScheme -> AuthScheme -> Bool)
-> (AuthScheme -> AuthScheme -> Bool) -> Eq AuthScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthScheme -> AuthScheme -> Bool
$c/= :: AuthScheme -> AuthScheme -> Bool
== :: AuthScheme -> AuthScheme -> Bool
$c== :: AuthScheme -> AuthScheme -> Bool
Eq)

-- | An auth scheme's @_KEY@ constant, usually defined in your Wordpress
-- site's @wp-config.php@. E.g., @LOGGED_IN_KEY@
newtype WordpressKey
    = WordpressKey { WordpressKey -> Text
unKey :: Text }
    deriving (Int -> WordpressKey -> ShowS
[WordpressKey] -> ShowS
WordpressKey -> String
(Int -> WordpressKey -> ShowS)
-> (WordpressKey -> String)
-> ([WordpressKey] -> ShowS)
-> Show WordpressKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordpressKey] -> ShowS
$cshowList :: [WordpressKey] -> ShowS
show :: WordpressKey -> String
$cshow :: WordpressKey -> String
showsPrec :: Int -> WordpressKey -> ShowS
$cshowsPrec :: Int -> WordpressKey -> ShowS
Show, WordpressKey -> WordpressKey -> Bool
(WordpressKey -> WordpressKey -> Bool)
-> (WordpressKey -> WordpressKey -> Bool) -> Eq WordpressKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordpressKey -> WordpressKey -> Bool
$c/= :: WordpressKey -> WordpressKey -> Bool
== :: WordpressKey -> WordpressKey -> Bool
$c== :: WordpressKey -> WordpressKey -> Bool
Eq)
-- | An auth scheme's @_SALT@ constant, usually defined in your Wordpress
-- site's @wp-config.php@. E.g., @LOGGED_IN_SALT@
newtype WordpressSalt
    = WordpressSalt { WordpressSalt -> Text
unSalt :: Text }
    deriving (Int -> WordpressSalt -> ShowS
[WordpressSalt] -> ShowS
WordpressSalt -> String
(Int -> WordpressSalt -> ShowS)
-> (WordpressSalt -> String)
-> ([WordpressSalt] -> ShowS)
-> Show WordpressSalt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordpressSalt] -> ShowS
$cshowList :: [WordpressSalt] -> ShowS
show :: WordpressSalt -> String
$cshow :: WordpressSalt -> String
showsPrec :: Int -> WordpressSalt -> ShowS
$cshowsPrec :: Int -> WordpressSalt -> ShowS
Show, WordpressSalt -> WordpressSalt -> Bool
(WordpressSalt -> WordpressSalt -> Bool)
-> (WordpressSalt -> WordpressSalt -> Bool) -> Eq WordpressSalt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordpressSalt -> WordpressSalt -> Bool
$c/= :: WordpressSalt -> WordpressSalt -> Bool
== :: WordpressSalt -> WordpressSalt -> Bool
$c== :: WordpressSalt -> WordpressSalt -> Bool
Eq)

-- | Build the @_KEY@ value for an authentiation scheme.
wpConfigKey :: Text -> WordpressKey
wpConfigKey :: Text -> WordpressKey
wpConfigKey = Text -> WordpressKey
WordpressKey

-- | Build the @_SALT@ value for an authentiation scheme.
wpConfigSalt :: Text -> WordpressSalt
wpConfigSalt :: Text -> WordpressSalt
wpConfigSalt = Text -> WordpressSalt
WordpressSalt



-- Helpers

newtype HashSecret = HashSecret Text
newtype HashMessage = HashMessage { HashMessage -> Text
hashMessage :: Text }
-- Apply an HMAC hashing function, converting the output to
-- a hex-representation.
hmacText
    :: (B.ByteString -> B.ByteString -> B.ByteString)
    -> HashSecret
    -> HashMessage
    -> Text
hmacText :: (ByteString -> ByteString -> ByteString)
-> HashSecret -> HashMessage -> Text
hmacText ByteString -> ByteString -> ByteString
hasher (HashSecret Text
secret) =
    ByteString -> Text
decodeUtf8
        (ByteString -> Text)
-> (HashMessage -> ByteString) -> HashMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
        (ByteString -> ByteString)
-> (HashMessage -> ByteString) -> HashMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
hasher (Text -> ByteString
encodeUtf8 Text
secret)
        (ByteString -> ByteString)
-> (HashMessage -> ByteString) -> HashMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
        (Text -> ByteString)
-> (HashMessage -> Text) -> HashMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMessage -> Text
hashMessage

-- Apply a hashing function to Text values, converting the output to
-- a hex-representation.
hashText :: (B.ByteString -> B.ByteString) -> HashMessage -> Text
hashText :: (ByteString -> ByteString) -> HashMessage -> Text
hashText ByteString -> ByteString
hasher =
    ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (HashMessage -> ByteString) -> HashMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (HashMessage -> ByteString) -> HashMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hasher (ByteString -> ByteString)
-> (HashMessage -> ByteString) -> HashMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (HashMessage -> Text) -> HashMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMessage -> Text
hashMessage

-- Join the different text to hash together by @|@ like Wordpress expects.
joinHashParts :: [Text] -> Text
joinHashParts :: [Text] -> Text
joinHashParts = Text -> [Text] -> Text
T.intercalate Text
"|"