{-# 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