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

openIdAuthenticationMethod :: AuthenticationMethod
openIdAuthenticationMethod :: AuthenticationMethod
openIdAuthenticationMethod = Text -> AuthenticationMethod
AuthenticationMethod Text
"openId"

------------------------------------------------------------------------------
-- OpenIdURL
------------------------------------------------------------------------------

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
$cp1Ord :: Eq OpenIdURL
Ord, Typeable OpenIdURL
DataType
Constr
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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenIdURL -> c OpenIdURL
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cRealm :: Constr
$cReturnTo :: Constr
$cBeginDance :: Constr
$cPartial :: Constr
$tOpenIdURL :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> OpenIdURL -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenIdURL -> u
gmapQ :: (forall d. Data d => d -> u) -> OpenIdURL -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenIdURL -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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 :: Router () (OpenIdURL :- ())
openIdURL =
  (  Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"partial"     Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (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 :- ())
-> Router () (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
  Router () (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (OpenIdURL :- ())
forall a. Semigroup a => a -> a -> a
<> Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"begin-dance" Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (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 :- ())
-> Router () (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
  Router () (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (OpenIdURL :- ())
forall a. Semigroup a => a -> a -> a
<> Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"return-to"   Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (OpenIdURL :- ())
forall b c a.
Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Router () (OpenIdURL :- ())
forall tok e r. Boomerang e tok r (OpenIdURL :- r)
rReturnTo
  Router () (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (OpenIdURL :- ())
forall a. Semigroup a => a -> a -> a
<> Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
"realm"       Boomerang TextsError [Text] (OpenIdURL :- ()) (OpenIdURL :- ())
-> Router () (OpenIdURL :- ()) -> Router () (OpenIdURL :- ())
forall b c a.
Boomerang TextsError [Text] b c
-> Boomerang TextsError [Text] a b
-> Boomerang TextsError [Text] a c
</> Router () (OpenIdURL :- ())
forall tok e r. Boomerang e tok r (OpenIdURL :- r)
rRealm
  )

instance PathInfo OpenIdURL where
  fromPathSegments :: URLParser OpenIdURL
fromPathSegments = Router () (OpenIdURL :- ()) -> URLParser OpenIdURL
forall url.
Boomerang TextsError [Text] () (url :- ()) -> URLParser url
boomerangFromPathSegments Router () (OpenIdURL :- ())
openIdURL
  toPathSegments :: OpenIdURL -> [Text]
toPathSegments   = Router () (OpenIdURL :- ()) -> OpenIdURL -> [Text]
forall url.
Boomerang TextsError [Text] () (url :- ()) -> url -> [Text]
boomerangToPathSegments   Router () (OpenIdURL :- ())
openIdURL

-- showOpenIdURL :: (MonadRoute m) => OpenIdURL -> m Text
nestOpenIdURL :: RouteT OpenIdURL m a -> RouteT AuthenticateURL m a
nestOpenIdURL :: 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