{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, QuasiQuotes, TemplateHaskell, TypeOperators, TypeSynonymInstances, OverloadedStrings #-}
module Happstack.Authenticate.Password.Partials where

import Control.Category                     ((.), id)
import Control.Lens                         ((^.))
import Control.Monad.Reader                 (ReaderT, ask, runReaderT)
import Control.Monad.Trans                  (MonadIO, lift)
import Data.Acid                            (AcidState)
import Data.Data                            (Data, Typeable)
import Data.Monoid                          ((<>))
import Data.Text                            (Text)
import Data.UserId                          (UserId)
import qualified Data.Text                  as Text
import qualified Data.Text.Lazy             as LT
import HSP
import Happstack.Server.HSP.HTML            ()
import Language.Haskell.HSX.QQ              (hsx)
import Language.Javascript.JMacro
import Happstack.Authenticate.Core          (AuthenticateState, AuthenticateURL, User(..), HappstackAuthenticateI18N(..), getToken, tokenUser, userId)
import Happstack.Authenticate.Password.Core (PasswordError(NotAuthenticated))
import Happstack.Authenticate.Password.URL  (AccountURL(..), PasswordURL(..), nestPasswordURL)
import Happstack.Authenticate.Password.PartialsURL  (PartialURL(..))
import Happstack.Server                     (Happstack, unauthorized)
import Happstack.Server.XMLGenT             ()
import HSP.JMacro                           ()
import Prelude                              hiding ((.), id)
import Text.Shakespeare.I18N                (Lang, mkMessageFor, renderMessage)
import Web.Routes
import Web.Routes.XMLGenT                   ()
import Web.Routes.TH                        (derivePathInfo)

type Partial' m = (RouteT AuthenticateURL (ReaderT [Lang] m))
type Partial  m = XMLGenT (RouteT AuthenticateURL (ReaderT [Lang] m))

data PartialMsgs
  = UsernameMsg
  | EmailMsg
  | PasswordMsg
  | PasswordConfirmationMsg
  | SignUpMsg
  | SignInMsg
  | LogoutMsg
  | OldPasswordMsg
  | NewPasswordMsg
  | NewPasswordConfirmationMsg
  | ChangePasswordMsg
  | RequestPasswordResetMsg

mkMessageFor "HappstackAuthenticateI18N" "PartialMsgs" "messages/password/partials" "en"

instance (Functor m, Monad m) => EmbedAsChild (Partial' m) PartialMsgs where
  asChild :: PartialMsgs -> GenChildList (Partial' m)
asChild PartialMsgs
msg =
    do [Lang]
lang <- XMLGenT (Partial' m) [Lang]
forall r (m :: * -> *). MonadReader r m => m r
ask
       Lang -> GenChildList (Partial' m)
forall (m :: * -> *) c. EmbedAsChild m c => c -> GenChildList m
asChild (Lang -> GenChildList (Partial' m))
-> Lang -> GenChildList (Partial' m)
forall a b. (a -> b) -> a -> b
$ HappstackAuthenticateI18N -> [Lang] -> PartialMsgs -> Lang
forall master message.
RenderMessage master message =>
master -> [Lang] -> message -> Lang
renderMessage HappstackAuthenticateI18N
HappstackAuthenticateI18N [Lang]
lang PartialMsgs
msg

instance (Functor m, Monad m) => EmbedAsAttr (Partial' m) (Attr LT.Text PartialMsgs) where
  asAttr :: Attr Text PartialMsgs -> GenAttributeList (Partial' m)
asAttr (Text
k := PartialMsgs
v) =
    do [Lang]
lang <- XMLGenT (Partial' m) [Lang]
forall r (m :: * -> *). MonadReader r m => m r
ask
       Attr Text Lang -> GenAttributeList (Partial' m)
forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr (Text
k Text -> Lang -> Attr Text Lang
forall n a. n -> a -> Attr n a
:= HappstackAuthenticateI18N -> [Lang] -> PartialMsgs -> Lang
forall master message.
RenderMessage master message =>
master -> [Lang] -> message -> Lang
renderMessage HappstackAuthenticateI18N
HappstackAuthenticateI18N [Lang]
lang PartialMsgs
v)

routePartial :: (Functor m, Monad m, Happstack m) =>
                AcidState AuthenticateState
             -> PartialURL
             -> Partial m XML
routePartial :: AcidState AuthenticateState -> PartialURL -> Partial m XML
routePartial AcidState AuthenticateState
authenticateState PartialURL
url =
  case PartialURL
url of
    PartialURL
LoginInline    -> Bool -> Partial m XML
forall (m :: * -> *). (Functor m, Monad m) => Bool -> Partial m XML
usernamePasswordForm Bool
True
    PartialURL
Login          -> Bool -> Partial m XML
forall (m :: * -> *). (Functor m, Monad m) => Bool -> Partial m XML
usernamePasswordForm Bool
False
    PartialURL
Logout         -> Partial m XML
forall (m :: * -> *). (Functor m, MonadIO m) => Partial m XML
logoutForm
    PartialURL
SignupPassword -> Partial m XML
forall (m :: * -> *). (Functor m, Monad m) => Partial m XML
signupPasswordForm
    PartialURL
ChangePassword ->
      do Maybe (Token, JWT VerifiedJWT)
mUser <- AcidState AuthenticateState
-> XMLGenT
     (RouteT AuthenticateURL (ReaderT [Lang] m))
     (Maybe (Token, JWT VerifiedJWT))
forall (m :: * -> *).
Happstack m =>
AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT))
getToken AcidState AuthenticateState
authenticateState
         case Maybe (Token, JWT VerifiedJWT)
mUser of
           Maybe (Token, JWT VerifiedJWT)
Nothing     -> XML -> Partial m XML
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
unauthorized (XML -> Partial m XML) -> Partial m XML -> Partial m XML
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [hsx| <p><% show NotAuthenticated %></p> |] -- FIXME: I18N
           (Just (Token
token, JWT VerifiedJWT
_)) -> UserId -> Partial m XML
forall (m :: * -> *).
(Functor m, MonadIO m) =>
UserId -> Partial m XML
changePasswordForm (Token
token Token -> Getting User Token User -> User
forall s a. s -> Getting a s a -> a
^. Getting User Token User
Lens' Token User
tokenUser User -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId User UserId
Lens' User UserId
userId)
    PartialURL
RequestResetPasswordForm -> Partial m XML
forall (m :: * -> *). (Functor m, MonadIO m) => Partial m XML
requestResetPasswordForm
    PartialURL
ResetPasswordForm -> Partial m XML
forall (m :: * -> *). (Functor m, MonadIO m) => Partial m XML
resetPasswordForm

signupPasswordForm :: (Functor m, Monad m) =>
                      Partial m XML
signupPasswordForm :: Partial m XML
signupPasswordForm =
     [hsx|
       <form ng-submit="signupPassword()" role="form">
        <div>{{signup_error}}</div>
        <div class="form-group">
         <label class="sr-only" for="su-username"><% UsernameMsg %></label>
         <input class="form-control" ng-model="signup.naUser.username" type="text" id="username" name="su-username" value="" placeholder=UsernameMsg />
        </div>
        <div class="form-group">
         <label class="sr-only" for="su-email"><% EmailMsg %></label>
         <input class="form-control" ng-model="signup.naUser.email" type="email" id="su-email" name="email" value="" placeholder=EmailMsg />
        </div>
        <div class="form-group">
         <label class="sr-only" for="su-password"><% PasswordMsg %></label>
         <input class="form-control" ng-model="signup.naPassword" type="password" id="su-password" name="su-pass" value="" placeholder=PasswordMsg />
        </div>
        <div class="form-group">
         <label class="sr-only" for="su-password-confirm"><% PasswordConfirmationMsg %></label>
         <input class="form-control" ng-model="signup.naPasswordConfirm" type="password" id="su-password-confirm" name="su-pass-confirm" value="" placeholder=PasswordConfirmationMsg />
        </div>
        <div class="form-group">
         <input class="form-control" type="submit" value=SignUpMsg />
        </div>
       </form>
  |]

usernamePasswordForm :: (Functor m, Monad m) =>
                        Bool
                     -> Partial m XML
usernamePasswordForm :: Bool -> Partial m XML
usernamePasswordForm Bool
inline = [hsx|
    <span>
     <span ng-show="!isAuthenticated">
      <form ng-submit="login()" role="form"  (if inline then ["class" := "navbar-form navbar-left"] :: [Attr Text Text] else [])>
       <div class="form-group">{{username_password_error}}</div>
       <div class="form-group">
        <label class="sr-only" for="username"><% UsernameMsg %> </label>
        <input class="form-control" ng-model="user.user" type="text" id="username" name="user" placeholder=UsernameMsg />
       </div><% " " :: Text %>
       <div class="form-group">
        <label class="sr-only" for="password"><% PasswordMsg %></label>
        <input class="form-control" ng-model="user.password" type="password" id="password" name="pass" placeholder=PasswordMsg />
       </div><% " " :: Text %>
       <div class="form-group">
       <input class="form-control" type="submit" value=SignInMsg />
       </div>
      </form>
     </span>
    </span>
  |]

logoutForm ::  (Functor m, MonadIO m) => Partial m XML
logoutForm :: Partial m XML
logoutForm = [hsx|
     <span ng-show="isAuthenticated">
      <div class="form-group">
       <a ng-click="logout()" href="#"><% LogoutMsg %></a>
      </div>
     </span>
 |]

changePasswordForm :: (Functor m, MonadIO m) =>
                      UserId
                   -> Partial m XML
changePasswordForm :: UserId -> Partial m XML
changePasswordForm UserId
userId =
  do Lang
url <- RouteT AuthenticateURL (ReaderT [Lang] m) Lang
-> XMLGenT (RouteT AuthenticateURL (ReaderT [Lang] m)) Lang
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RouteT AuthenticateURL (ReaderT [Lang] m) Lang
 -> XMLGenT (RouteT AuthenticateURL (ReaderT [Lang] m)) Lang)
-> RouteT AuthenticateURL (ReaderT [Lang] m) Lang
-> XMLGenT (RouteT AuthenticateURL (ReaderT [Lang] m)) Lang
forall a b. (a -> b) -> a -> b
$ RouteT PasswordURL (ReaderT [Lang] m) Lang
-> RouteT AuthenticateURL (ReaderT [Lang] m) Lang
forall (m :: * -> *) a.
RouteT PasswordURL m a -> RouteT AuthenticateURL m a
nestPasswordURL (RouteT PasswordURL (ReaderT [Lang] m) Lang
 -> RouteT AuthenticateURL (ReaderT [Lang] m) Lang)
-> RouteT PasswordURL (ReaderT [Lang] m) Lang
-> RouteT AuthenticateURL (ReaderT [Lang] m) Lang
forall a b. (a -> b) -> a -> b
$ URL (RouteT PasswordURL (ReaderT [Lang] m))
-> RouteT PasswordURL (ReaderT [Lang] m) Lang
forall (m :: * -> *). MonadRoute m => URL m -> m Lang
showURL (Maybe (UserId, AccountURL) -> PasswordURL
Account ((UserId, AccountURL) -> Maybe (UserId, AccountURL)
forall a. a -> Maybe a
Just (UserId
userId, AccountURL
Password)))
     let changePasswordFn :: Lang
changePasswordFn = Lang
"changePassword('" Lang -> Lang -> Lang
forall a. Semigroup a => a -> a -> a
<> Lang
url Lang -> Lang -> Lang
forall a. Semigroup a => a -> a -> a
<> Lang
"')"
     [hsx|
       <form ng-submit=changePasswordFn role="form">
        <div class="form-group">{{change_password_error}}</div>
        <div class="form-group">
         <label class="sr-only" for="password"><% OldPasswordMsg %></label>
         <input class="form-control" ng-model="password.cpOldPassword" type="password" id="old-password" name="old-pass" placeholder=OldPasswordMsg />
        </div>
        <div class="form-group">
         <label class="sr-only" for="password"><% NewPasswordMsg %></label>
         <input class="form-control" ng-model="password.cpNewPassword" type="password" id="new-password" name="new-pass" placeholder=NewPasswordMsg />
        </div>
        <div class="form-group">
         <label class="sr-only" for="password"><% NewPasswordConfirmationMsg %></label>
         <input class="form-control" ng-model="password.cpNewPasswordConfirm" type="password" id="new-password-confirm" name="new-pass-confirm" placeholder=NewPasswordConfirmationMsg />
        </div>
        <div class="form-group">
         <input class="form-control" type="submit" value=ChangePasswordMsg />
        </div>
       </form>

     |]

requestResetPasswordForm :: (Functor m, MonadIO m) =>
                            Partial m XML
requestResetPasswordForm :: Partial m XML
requestResetPasswordForm =
  do -- url <- lift $ nestPasswordURL $ showURL PasswordReset
     -- let changePasswordFn = "resetPassword('" <> url <> "')"
     [hsx|
      <div>
       <form ng-submit="requestResetPassword()" role="form">
        <div class="form-group">{{request_reset_password_msg}}</div>
        <div class="form-group">
         <label class="sr-only" for="reset-username"><% UsernameMsg %></label>
         <input class="form-control" ng-model="requestReset.rrpUsername" type="text" id="reset-username" name="username" placeholder=UsernameMsg />
        </div>
        <div class="form-group">
         <input class="form-control" type="submit" value=RequestPasswordResetMsg />
        </div>
       </form>
      </div>
     |]

resetPasswordForm :: (Functor m, MonadIO m) =>
                     Partial m XML
resetPasswordForm :: Partial m XML
resetPasswordForm =
  [hsx|
      <div>
       <form ng-submit="resetPassword()" role="form">
        <div class="form-group">{{reset_password_msg}}</div>
        <div class="form-group">
         <label class="sr-only" for="reset-password"><% PasswordMsg %></label>
         <input class="form-control" ng-model="reset.rpPassword" type="password" id="reset-password" name="reset-password" placeholder=PasswordMsg />
        </div>
        <div class="form-group">
         <label class="sr-only" for="reset-password-confirm"><% PasswordConfirmationMsg %></label>
         <input class="form-control" ng-model="reset.rpPasswordConfirm" type="password" id="reset-password-confirm" name="reset-password-confirm" placeholder=PasswordConfirmationMsg />
        </div>
        <div class="form-group">
         <input class="form-control" type="submit" value=ChangePasswordMsg />
        </div>
       </form>
      </div>
  |]