Paypal button.
This commit is contained in:
		
							parent
							
								
									0ab978e231
								
							
						
					
					
						commit
						7aad59073b
					
				
					 3 changed files with 56 additions and 4 deletions
				
			
		| 
						 | 
					@ -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
									
								
							
							
						
						
									
										15
									
								
								src/App/Container.js
									
										
									
									
									
										Normal 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;
 | 
				
			||||||
 | 
					    };
 | 
				
			||||||
 | 
					  };
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -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.
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		
		Reference in a new issue