{-# LANGUAGE DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, TemplateHaskell, TypeFamilies, TypeSynonymInstances, TypeOperators, OverloadedStrings #-}
module Happstack.Authenticate.OpenId.URL where
import Control.Category ((.), id)
import Data.Data (Data, Typeable)
import Data.Text (Text)
import Data.UserId (UserId, rUserId)
import GHC.Generics (Generic)
import Prelude hiding ((.), id)
import Happstack.Authenticate.Core (AuthenticateURL, AuthenticationMethod(..), nestAuthenticationMethod)
import Happstack.Authenticate.OpenId.PartialsURL (PartialURL(..), partialURL)
import Text.Boomerang.TH (makeBoomerangs)
import Web.Routes (PathInfo(..), RouteT(..))
import Web.Routes.TH (derivePathInfo)
import Web.Routes.Boomerang
openIdAuthenticationMethod :: AuthenticationMethod
openIdAuthenticationMethod :: AuthenticationMethod
openIdAuthenticationMethod = Text -> AuthenticationMethod
AuthenticationMethod Text
"openId"
data OpenIdURL
= Partial PartialURL
| BeginDance Text
| ReturnTo
| Realm
deriving (OpenIdURL -> OpenIdURL -> Bool
(OpenIdURL -> OpenIdURL -> Bool)
-> (OpenIdURL -> OpenIdURL -> Bool) -> Eq OpenIdURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenIdURL -> OpenIdURL -> Bool
$c/= :: OpenIdURL -> OpenIdURL -> Bool
== :: OpenIdURL -> OpenIdURL -> Bool
$c== :: OpenIdURL -> OpenIdURL -> Bool
Eq, Eq OpenIdURL
Eq OpenIdURL
-> (OpenIdURL -> OpenIdURL -> Ordering)
-> (OpenIdURL -> OpenIdURL -> Bool)
-> (OpenIdURL -> OpenIdURL -> Bool)
-> (OpenIdURL -> OpenIdURL -> Bool)
-> (OpenIdURL -> OpenIdURL -> Bool)
-> (OpenIdURL -> OpenIdURL -> OpenIdURL)
-> (OpenIdURL -> OpenIdURL -> OpenIdURL)
-> Ord OpenIdURL
OpenIdURL -> OpenIdURL -> Bool
OpenIdURL -> OpenIdURL -> Ordering
OpenIdURL -> OpenIdURL -> OpenIdURL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpenIdURL -> OpenIdURL -> OpenIdURL
$cmin :: OpenIdURL -> OpenIdURL -> OpenIdURL
max :: OpenIdURL -> OpenIdURL -> OpenIdURL
$cmax :: OpenIdURL -> OpenIdURL -> OpenIdURL
>= :: OpenIdURL -> OpenIdURL -> Bool
$c>= :: OpenIdURL -> OpenIdURL -> Bool
> :: OpenIdURL -> OpenIdURL -> Bool
$c> :: OpenIdURL -> OpenIdURL -> Bool
<= :: OpenIdURL -> OpenIdURL -> Bool
$c<= :: OpenIdURL -> OpenIdURL -> Bool
< :: OpenIdURL -> OpenIdURL -> Bool
$c< :: OpenIdURL -> OpenIdURL -> Bool
compare :: OpenIdURL -> OpenIdURL -> Ordering
$ccompare :: OpenIdURL -> OpenIdURL -> Ordering
Ord, Typeable OpenIdURL
Typeable OpenIdURL
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenIdURL -> c OpenIdURL)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenIdURL)
-> (OpenIdURL -> Constr)
-> (OpenIdURL -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenIdURL))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenIdURL))
-> ((forall b. Data b => b -> b) -> OpenIdURL -> OpenIdURL)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r)
-> (forall u. (forall d. Data d => d -> u) -> OpenIdURL -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> OpenIdURL -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL)
-> Data OpenIdURL
OpenIdURL -> DataType
OpenIdURL -> Constr
(forall b. Data b => b -> b) -> OpenIdURL -> OpenIdURL
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OpenIdURL -> u
forall u. (forall d. Data d => d -> u) -> OpenIdURL -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenIdURL
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenIdURL -> c OpenIdURL
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenIdURL)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenIdURL)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenIdURL -> m OpenIdURL
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenIdURL -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenIdURL -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OpenIdURL -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenIdURL -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenIdURL -> r
gmapT :: (forall b. Data b => b -> b) -> OpenIdURL -> OpenIdURL
$cgmapT :: (forall b. Data b => b -> b) -> OpenIdURL -> OpenIdURL
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenIdURL)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenIdURL)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenIdURL)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenIdURL)
dataTypeOf :: OpenIdURL -> DataType
$cdataTypeOf :: OpenIdURL -> DataType
toConstr :: OpenIdURL -> Constr
$ctoConstr :: OpenIdURL -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenIdURL
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenIdURL
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenIdURL -> c OpenIdURL
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenIdURL -> c OpenIdURL
Data, Typeable, (forall x. OpenIdURL -> Rep OpenIdURL x)
-> (forall x. Rep OpenIdURL x -> OpenIdURL) -> Generic OpenIdURL
forall x. Rep OpenIdURL x -> OpenIdURL
forall x. OpenIdURL -> Rep OpenIdURL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpenIdURL x -> OpenIdURL
$cfrom :: forall x. OpenIdURL -> Rep OpenIdURL x
Generic, ReadPrec [OpenIdURL]
ReadPrec OpenIdURL
Int -> ReadS OpenIdURL
ReadS [OpenIdURL]
(Int -> ReadS OpenIdURL)
-> ReadS [OpenIdURL]
-> ReadPrec OpenIdURL
-> ReadPrec [OpenIdURL]
-> Read OpenIdURL
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenIdURL]
$creadListPrec :: ReadPrec [OpenIdURL]
readPrec :: ReadPrec OpenIdURL
$creadPrec :: ReadPrec OpenIdURL
readList :: ReadS [OpenIdURL]
$creadList :: ReadS [OpenIdURL]
readsPrec :: Int -> ReadS OpenIdURL
$creadsPrec :: Int -> ReadS OpenIdURL
Read, Int -> OpenIdURL -> ShowS
[OpenIdURL] -> ShowS
OpenIdURL -> String
(Int -> OpenIdURL -> ShowS)
-> (OpenIdURL -> String)
-> ([OpenIdURL] -> ShowS)
-> Show OpenIdURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenIdURL] -> ShowS
$cshowList :: [OpenIdURL] -> ShowS
show :: OpenIdURL -> String
$cshow :: OpenIdURL -> String
showsPrec :: Int -> OpenIdURL -> ShowS
$cshowsPrec :: Int -> OpenIdURL -> ShowS
Show)
makeBoomerangs ''OpenIdURL
openIdURL :: Router () (OpenIdURL :- ())
openIdURL :: Boomerang TextsError [Text] () (OpenIdURL :- ())
openIdURL =
( Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"partial" Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall b c a.
Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Boomerang TextsError [Text] (PartialURL :- ()) (OpenIdURL :- ())
forall tok e r. Boomerang e tok (PartialURL :- r) (OpenIdURL :- r)
rPartial Boomerang TextsError [Text] (PartialURL :- ()) (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (PartialURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang TextsError [Text] () (PartialURL :- ())
partialURL
Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall a. Semigroup a => a -> a -> a
<> Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"begin-dance" Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall b c a.
Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Boomerang TextsError [Text] (Text :- ()) (OpenIdURL :- ())
forall tok e r. Boomerang e tok (Text :- r) (OpenIdURL :- r)
rBeginDance Boomerang TextsError [Text] (Text :- ()) (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (Text :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang TextsError [Text] () (Text :- ())
forall r. Boomerang TextsError [Text] r (Text :- r)
anyText
Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall a. Semigroup a => a -> a -> a
<> Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"return-to" Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall b c a.
Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall tok e r. Boomerang e tok r (OpenIdURL :- r)
rReturnTo
Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall a. Semigroup a => a -> a -> a
<> Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"realm" Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
-> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall b c a.
Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Boomerang TextsError [Text] () (OpenIdURL :- ())
forall tok e r. Boomerang e tok r (OpenIdURL :- r)
rRealm
)
instance PathInfo OpenIdURL where
fromPathSegments :: URLParser OpenIdURL
fromPathSegments = Boomerang TextsError [Text] () (OpenIdURL :- ())
-> URLParser OpenIdURL
forall url.
Boomerang TextsError [Text] () (url :- ()) -> URLParser url
boomerangFromPathSegments Boomerang TextsError [Text] () (OpenIdURL :- ())
openIdURL
toPathSegments :: OpenIdURL -> [Text]
toPathSegments = Boomerang TextsError [Text] () (OpenIdURL :- ())
-> OpenIdURL -> [Text]
forall url.
Boomerang TextsError [Text] () (url :- ()) -> url -> [Text]
boomerangToPathSegments Boomerang TextsError [Text] () (OpenIdURL :- ())
openIdURL
nestOpenIdURL :: RouteT OpenIdURL m a -> RouteT AuthenticateURL m a
nestOpenIdURL :: forall (m :: * -> *) a.
RouteT OpenIdURL m a -> RouteT AuthenticateURL m a
nestOpenIdURL =
AuthenticationMethod
-> RouteT OpenIdURL m a -> RouteT AuthenticateURL m a
forall methodURL (m :: * -> *) a.
PathInfo methodURL =>
AuthenticationMethod
-> RouteT methodURL m a -> RouteT AuthenticateURL m a
nestAuthenticationMethod AuthenticationMethod
openIdAuthenticationMethod