{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE KindSignatures #-} module Snap.Snaplet.CustomAuth.Util where import Control.Error.Util import Control.Monad.State import Data.ByteString (ByteString) import Data.Monoid import Data.Text (Text) import Data.Text.Encoding import Snap hiding (path) import Snap.Snaplet.CustomAuth.AuthManager getStateName :: Handler b (AuthManager u e b) Text getStateName :: Handler b (AuthManager u e b) Text getStateName = do Text path <- Text -> (Text -> Text) -> Maybe Text -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "auth" Text -> Text forall a. a -> a id (Maybe Text -> Text) -> (ByteString -> Maybe Text) -> ByteString -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Either UnicodeException Text -> Maybe Text forall a b. Either a b -> Maybe b hush (Either UnicodeException Text -> Maybe Text) -> (ByteString -> Either UnicodeException Text) -> ByteString -> Maybe Text forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Either UnicodeException Text decodeUtf8' (ByteString -> Text) -> Handler b (AuthManager u e b) ByteString -> Handler b (AuthManager u e b) Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Handler b (AuthManager u e b) ByteString forall (m :: * -> * -> * -> *) b v. (Monad (m b v), MonadSnaplet m) => m b v ByteString getSnapletRootURL Text name <- Text -> (Text -> Text) -> Maybe Text -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "auth" Text -> Text forall a. a -> a id (Maybe Text -> Text) -> Handler b (AuthManager u e b) (Maybe Text) -> Handler b (AuthManager u e b) Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Handler b (AuthManager u e b) (Maybe Text) forall (m :: * -> * -> * -> *) b v. (Monad (m b v), MonadSnaplet m) => m b v (Maybe Text) getSnapletName Text -> Handler b (AuthManager u e b) Text forall (m :: * -> *) a. Monad m => a -> m a return (Text -> Handler b (AuthManager u e b) Text) -> Text -> Handler b (AuthManager u e b) Text forall a b. (a -> b) -> a -> b $ Text "__" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "_" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text path Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "_state" getParamText :: forall (f :: * -> *). MonadSnap f => ByteString -> f (Maybe Text) getParamText :: ByteString -> f (Maybe Text) getParamText ByteString n = (Either UnicodeException Text -> Maybe Text forall a b. Either a b -> Maybe b hush (Either UnicodeException Text -> Maybe Text) -> (ByteString -> Either UnicodeException Text) -> ByteString -> Maybe Text forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Either UnicodeException Text decodeUtf8' (ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<) (Maybe ByteString -> Maybe Text) -> f (Maybe ByteString) -> f (Maybe Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ByteString -> f (Maybe ByteString) forall (m :: * -> *). MonadSnap m => ByteString -> m (Maybe ByteString) getParam ByteString n setFailure :: Handler b (AuthManager u e b) () -> Maybe Text -> Either e (AuthFailure e) -> Handler b (AuthManager u e b) () setFailure :: Handler b (AuthManager u e b) () -> Maybe Text -> Either e (AuthFailure e) -> Handler b (AuthManager u e b) () setFailure Handler b (AuthManager u e b) () action Maybe Text provider Either e (AuthFailure e) failure = do let failure' :: AuthFailure e failure' = (e -> AuthFailure e) -> (AuthFailure e -> AuthFailure e) -> Either e (AuthFailure e) -> AuthFailure e forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either e -> AuthFailure e forall e. e -> AuthFailure e UserError AuthFailure e -> AuthFailure e forall a. a -> a id Either e (AuthFailure e) failure (AuthManager u e b -> AuthManager u e b) -> Handler b (AuthManager u e b) () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((AuthManager u e b -> AuthManager u e b) -> Handler b (AuthManager u e b) ()) -> (AuthManager u e b -> AuthManager u e b) -> Handler b (AuthManager u e b) () forall a b. (a -> b) -> a -> b $ \AuthManager u e b s -> AuthManager u e b s { oauth2Provider :: Maybe Text oauth2Provider = Maybe Text provider , authFailData :: Maybe (AuthFailure e) authFailData = AuthFailure e -> Maybe (AuthFailure e) forall a. a -> Maybe a Just AuthFailure e failure' } Handler b (AuthManager u e b) () action