{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Wordpress.Auth
(
authorizeWordpressRequest
, WPAuthConfig(..)
, UserAuthData(..)
, WPAuthorization(..)
, WPAuthError(..)
, CookieName(..)
, cookieName
, findCookie
, CookieHeaderError(..)
, findNonce
, WPCookie(..)
, CookieToken(..)
, parseWordpressCookie
, CookieParseError(..)
, validateCookie
, WordpressUserPass(..)
, CookieValidationError(..)
, validateCookieHash
, SessionToken(..)
, decodeSessionTokens
, validateSessionToken
, NonceTick(..)
, wordpressNonceTick
, validateNonce
, WordpressUserId(..)
, 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 )
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
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)
data WPAuthConfig m a
= WPAuthConfig
{ WPAuthConfig m a -> m CookieName
getCookieName :: m CookieName
, WPAuthConfig m a -> AuthScheme
loggedInScheme :: AuthScheme
, WPAuthConfig m a -> AuthScheme
nonceScheme :: AuthScheme
, WPAuthConfig m a -> POSIXTime
nonceLifetime :: NominalDiffTime
, WPAuthConfig m a -> Text -> m (Maybe (UserAuthData a))
getUserData :: Text -> m (Maybe (UserAuthData a))
, WPAuthConfig m a -> WPAuthError -> m (WPAuthorization a)
onAuthenticationFailure :: WPAuthError -> m (WPAuthorization a)
}
data UserAuthData a =
UserAuthData
{ UserAuthData a -> a
userData :: a
, UserAuthData a -> WordpressUserId
wpUser :: WordpressUserId
, UserAuthData a -> WordpressUserPass
wpPass :: WordpressUserPass
, UserAuthData a -> [SessionToken]
wpTokens :: [SessionToken]
}
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)
data WPAuthError
= CookieHeaderError
| EParse CookieParseError
| EValid CookieValidationError
| UserDataNotFound
| NoNonce
| InvalidNonce
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)
data CookieName
= CustomCookieName Text
| CookieNameWithMD5 Text Text
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)
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)
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
data
=
| NoCookieMatches
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)
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)
data WPCookie
= WPCookie
{ WPCookie -> Text
username :: Text
, WPCookie -> POSIXTime
expiration :: POSIXTime
, WPCookie -> CookieToken
token :: CookieToken
, WPCookie -> Text
hmac :: Text
}
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)
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)
data CookieParseError
= MalformedCookie
| InvalidExpiration
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)
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
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)
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)
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)
validateCookie
:: AuthScheme
-> POSIXTime
-> WPCookie
-> WordpressUserPass
-> [SessionToken]
-> 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 ()
data CookieValidationError
= CookieExpired
| InvalidHash
| InvalidToken
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)
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
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
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)
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
_ -> []
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
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
validateSessionToken
:: POSIXTime
-> CookieToken
-> [SessionToken]
-> 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
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)
wordpressNonceTick
:: NominalDiffTime
-> POSIXTime
-> 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
validateNonce
:: AuthScheme
-> Maybe CookieToken
-> NonceTick
-> Maybe WordpressUserId
-> Text
-> Text
-> 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
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)
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)
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)
wpConfigKey :: Text -> WordpressKey
wpConfigKey :: Text -> WordpressKey
wpConfigKey = Text -> WordpressKey
WordpressKey
wpConfigSalt :: Text -> WordpressSalt
wpConfigSalt :: Text -> WordpressSalt
wpConfigSalt = Text -> WordpressSalt
WordpressSalt
newtype HashSecret = HashSecret Text
newtype HashMessage = HashMessage { HashMessage -> Text
hashMessage :: Text }
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
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
joinHashParts :: [Text] -> Text
joinHashParts :: [Text] -> Text
joinHashParts = Text -> [Text] -> Text
T.intercalate Text
"|"