Paypal button.

This commit is contained in:
Philippe Pittoli 2024-11-17 01:38:05 +01:00
parent 0ab978e231
commit 7aad59073b
3 changed files with 56 additions and 4 deletions

View File

@ -14,6 +14,7 @@
, "effect" , "effect"
, "either" , "either"
, "exceptions" , "exceptions"
, "foldable-traversable"
, "foreign" , "foreign"
, "generic-parser" , "generic-parser"
, "halogen" , "halogen"

15
src/App/Container.js Normal file
View File

@ -0,0 +1,15 @@
// Sets some raw HTML into a page given an element.
// In the Halogen code, the parameter is of type `Web.HTML.HTMLElement`.
//
// Function signature: Web.HTML.HTMLElement -> RawHTML -> Effect Unit
//
// `RawHTML` is just a wrapper around a `String`. Nothing fancy.
//
// newtype RawHTML = RawHTML String
export function unsafeSetInnerHTML(element) {
return function (html) {
return function () {
element.innerHTML = html;
};
};
}

View File

@ -50,15 +50,18 @@ import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (&
import Bulma as Bulma import Bulma as Bulma
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..), maybe) import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (for_)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff)
import Effect (Effect)
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
import Halogen.HTML.Properties as HP import Halogen.HTML.Properties as HP
import Type.Proxy (Proxy(..)) import Type.Proxy (Proxy(..))
import Effect.Aff.Class (class MonadAff) import Web.HTML (HTMLElement)
import Data.ArrayBuffer.Types (ArrayBuffer)
import App.Message.DNSManagerDaemon as DNSManager import App.Message.DNSManagerDaemon as DNSManager
import App.Message.AuthenticationDaemon as AuthD import App.Message.AuthenticationDaemon as AuthD
@ -96,6 +99,12 @@ type Login = String
type Password = String type Password = String
type LogInfo = Tuple Login Password type LogInfo = Tuple Login Password
newtype RawHTML = RawHTML String
-- | Since Halogen doesn't have a function to put raw HTML into a page, we have to improvise.
-- | This foreign function adds raw HTML into a page, given a parent node reference.
foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit
-- | A keepalive message is sent every 30 seconds to keep the connection open. -- | A keepalive message is sent every 30 seconds to keep the connection open.
-- | `max_keepalive` represents the maximum number of keepalive messages -- | `max_keepalive` represents the maximum number of keepalive messages
-- | before closing the connections due to inactivity. -- | before closing the connections due to inactivity.
@ -282,10 +291,19 @@ render state
-- The footer includes logs and both the WS child components. -- The footer includes logs and both the WS child components.
, Bulma.hr , Bulma.hr
, Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails 😅)", render_logs ] , Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails 😅)", render_logs ]
, Bulma.column_ [ Bulma.level [render_auth_WS, render_dnsmanager_WS, legal_notice_btn] [] ] , Bulma.column_ [ Bulma.level
[ render_auth_WS
, render_dnsmanager_WS
, legal_notice_btn
, paypal_btn
] [] ]
] ]
] ]
where where
paypal_btn :: forall w i. HH.HTML w i
paypal_btn = HH.div [ HP.ref ref_paypal_div ] []
legal_notice_btn = Bulma.btn_ [] "Legal notice" (Routing LegalNotice) legal_notice_btn = Bulma.btn_ [] "Legal notice" (Routing LegalNotice)
reconnection_bar :: forall w. HH.HTML w Action reconnection_bar :: forall w. HH.HTML w Action
reconnection_bar = reconnection_bar =
@ -348,6 +366,9 @@ render state
render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ] render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ]
ref_paypal_div :: H.RefLabel
ref_paypal_div = H.RefLabel "paypal-div"
handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
handleAction = case _ of handleAction = case _ of
Initialize -> do Initialize -> do
@ -364,6 +385,21 @@ handleAction = case _ of
Just name -> do H.modify_ _ { login = Just name } Just name -> do H.modify_ _ { login = Just name }
H.tell _nav unit $ NavigationInterface.TellLogin (Just name) H.tell _nav unit $ NavigationInterface.TellLogin (Just name)
-- Render the paypal button.
-- How it works: it takes all nodes in the DOM with the reference `ref_paypal_div` ("paypal-div")
-- then it replaces the inner HTML by the provided code.
parentElem <- H.getHTMLElementRef ref_paypal_div
for_ parentElem \el -> do
H.liftEffect $ unsafeSetInnerHTML el (RawHTML """
<form action="https://www.paypal.com/donate" method="post" target="_blank">
<input type="hidden" name="business" value="YBYNZTGHQK5VA" />
<input type="hidden" name="no_recurring" value="0" />
<input type="hidden" name="currency_code" value="EUR" />
<input type="image" src="https://www.paypalobjects.com/en_US/i/btn/btn_donate_LG.gif" border="0" name="submit" title="PayPal - The safer, easier way to pay online!" alt="Donate with PayPal button" />
<img alt="" border="0" src="https://www.paypal.com/en_FR/i/scr/pixel.gif" width="1" height="1" />
</form>
""")
Routing page -> do Routing page -> do
-- Each time the user change load a new page, the counter gets reset -- Each time the user change load a new page, the counter gets reset
-- since it proves they are still active. -- since it proves they are still active.