570 lines
26 KiB
Text
570 lines
26 KiB
Text
-- | `App.Templates.Table` gathers all the website's tables, providing
|
||
-- | an easy way to duplicate tables in different pages and to display
|
||
-- | content in a consistent manner.
|
||
module App.Templates.Table
|
||
( owned_domains
|
||
, shared_domains
|
||
, resource_records
|
||
, display_dmarc_mail_addresses
|
||
, display_modifiers
|
||
, display_mechanisms
|
||
) where
|
||
|
||
import Prelude (comparing, map, not, show, (#), ($), (&&), (<<<), (<>), (==), (>))
|
||
|
||
import CSSClasses as C
|
||
|
||
import Data.Array.NonEmpty as NonEmpty
|
||
import Data.Array as A
|
||
import Data.Maybe (Maybe(..), fromMaybe, maybe)
|
||
|
||
import Data.Tuple (Tuple(..))
|
||
|
||
import Web as Web
|
||
import Web.Button as Button
|
||
import Bulma as Bulma
|
||
import Halogen.HTML as HH
|
||
import Halogen.HTML.Properties as HP
|
||
import Data.String.CodePoints as CP
|
||
import Utils (id, attach_id)
|
||
import App.Type.DMARC as DMARC
|
||
|
||
import App.Type.ResourceRecord (ResourceRecord
|
||
, show_mechanism, show_mechanism_type
|
||
, show_modifier, show_modifier_type
|
||
, show_qualifier, show_qualifier_char)
|
||
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier) as RR
|
||
|
||
import App.Type.DomainInfo (DomainInfo)
|
||
|
||
txt_name :: forall w i. String -> HH.HTML w i
|
||
txt_name t
|
||
= HH.td [ rr_name_style ] [ rr_name_text ]
|
||
where
|
||
rr_name_style = HP.style "width: 80px;"
|
||
rr_name_text = HH.text t
|
||
|
||
owned_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i
|
||
owned_domains domains_i_exclusively_own action_enter_domain action_transfer_domain action_share_domain action_delete_domain
|
||
= if A.length domains_i_exclusively_own > 0
|
||
then Web.table [] [ owned_domains_table_header
|
||
, HH.tbody_ $ map owned_domain_row domains_i_exclusively_own
|
||
]
|
||
else Web.p "No domain yet."
|
||
where
|
||
owned_domains_table_header :: HH.HTML w i
|
||
owned_domains_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
owned_domain_row domain = HH.tr_
|
||
[ HH.td_ [ Button.btn domain.name (action_enter_domain domain.name) ]
|
||
, case domain.transfer_key of
|
||
Just key -> HH.td_ [ Web.p "Token key:", Web.p key ]
|
||
Nothing -> HH.td_ [ Button.btn_abbr "Generate a token to transfer the ownership of a domain." "Transfer" (action_transfer_domain domain.name) ]
|
||
, HH.td_ [ Button.btn_abbr "Generate a token to share the ownership of a domain." "Share" (action_share_domain domain.name) ]
|
||
, HH.td_ [ Button.alert_btn_abbr "Delete the domain. This will remove all zone data and the domain won't be served anymore." "Delete" (action_delete_domain domain.name) ]
|
||
]
|
||
|
||
shared_domains :: forall w i. Array DomainInfo -> (String -> i) -> (String -> i) -> (String -> i) -> HH.HTML w i
|
||
shared_domains domains_i_share action_enter_domain action_unshare_domain action_delete_domain
|
||
= if A.length domains_i_share > 0
|
||
then Web.table [] [ shared_domains_table_header
|
||
, HH.tbody_ $ map shared_domain_row domains_i_share
|
||
]
|
||
else Web.p "No domain yet."
|
||
where
|
||
shared_domains_table_header :: HH.HTML w i
|
||
shared_domains_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
|
||
, HH.th_ [ HH.text "Share key" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
shared_domain_row domain = HH.tr_
|
||
[ HH.td_ [ Button.btn domain.name (action_enter_domain domain.name) ]
|
||
, HH.td_ [ HH.text $ fromMaybe "" domain.share_key ]
|
||
, if A.length domain.owners == 1
|
||
then HH.td_ [ Button.alert_btn_abbr "Unshare the domain by removing the \"share\" token." "Unshare" (action_unshare_domain domain.name) ]
|
||
else HH.td_ [ Button.btn_ro [C.is_warning] "Cannot unshare it" ]
|
||
, HH.td_ [ Button.alert_btn_abbr "Delete the domain from your list of owned domains. In case you are the only owner, this will also remove all zone data and the domain won't be served anymore." "Delete" (action_delete_domain domain.name) ]
|
||
]
|
||
|
||
-- | Render all Resource Records.
|
||
resource_records :: forall w i. Array ResourceRecord -> (Int -> i) -> (Int -> i) -> (Int -> i) -> HH.HTML w i
|
||
resource_records [] _ _ _ = Web.box [Bulma.zone_rr_title "Resource records", Bulma.subtitle "No records for now"]
|
||
resource_records records action_create_or_update_rr action_delete_rr action_new_token
|
||
= HH.div_ $
|
||
(rr_box [bg_color_ro] tag_soa soa_table_header table_content all_soa_rr)
|
||
<> (rr_box [] tag_basic simple_table_header table_content_w_seps all_basic_rr)
|
||
<> (rr_box [] tag_mx mx_table_header table_content all_mx_rr)
|
||
<> (rr_box [] tag_caa caa_table_header table_content all_caa_rr)
|
||
<> (rr_box [] tag_srv srv_table_header table_content all_srv_rr)
|
||
<> (rr_box [] tag_spf spf_table_header table_content all_spf_rr)
|
||
<> (rr_box [] tag_dkim dkim_table_header table_content all_dkim_rr)
|
||
<> (rr_box [] tag_dmarc dmarc_table_header table_content all_dmarc_rr)
|
||
<> (rr_box [bg_color_ro] tag_basic_ro simple_table_header_ro table_content_w_seps all_basic_ro_rr)
|
||
where
|
||
bg_color_ro = C.has_background_warning_light :: HH.ClassName
|
||
|
||
baseRecords :: Array String
|
||
baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
|
||
|
||
all_basic_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
|
||
all_basic_ro_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && rr.readonly) records
|
||
all_XX_rr str = A.filter (\rr -> rr.rrtype == str) records
|
||
all_soa_rr = all_XX_rr "SOA"
|
||
all_mx_rr = all_XX_rr "MX"
|
||
all_caa_rr = all_XX_rr "CAA"
|
||
all_srv_rr = all_XX_rr "SRV"
|
||
all_spf_rr = all_XX_rr "SPF"
|
||
all_dkim_rr = all_XX_rr "DKIM"
|
||
all_dmarc_rr = all_XX_rr "DMARC"
|
||
|
||
tag_soa = Web.tags [Web.tag_ro "SOA", Web.tag_ro "read only"]
|
||
tag_basic = Web.tags [Web.tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"]
|
||
tag_mx = Web.tags [Web.tag "MX"]
|
||
tag_caa = Web.tags [Web.tag "CAA"]
|
||
tag_srv = Web.tags [Web.tag "SRV"]
|
||
tag_spf = Web.tags [Web.tag "SPF"]
|
||
tag_dkim = Web.tags [Web.tag "DKIM"]
|
||
tag_dmarc = Web.tags [Web.tag "DMARC"]
|
||
tag_basic_ro = Web.tags [Web.tag_ro "Basic Resource Records", Web.tag_ro "read only"]
|
||
|
||
rr_box :: Array HH.ClassName -- css classes (such as colors)
|
||
-> HH.HTML w i -- box title (type of data)
|
||
-> HH.HTML w i -- table title
|
||
-> (Array ResourceRecord -> HH.HTML w i)
|
||
-> Array ResourceRecord
|
||
-> Array (HH.HTML w i)
|
||
rr_box colors title header dp rrs =
|
||
if A.length rrs > 0
|
||
then [ Web.box_with_tag colors title [Web.table_ [C.margin_left 3] [] [header, dp rrs]] ]
|
||
else []
|
||
--title_col_props = C.is 1
|
||
|
||
table_content_w_seps records_ = HH.tbody_ $
|
||
A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
|
||
# map NonEmpty.toArray -- -> [[xx], [yy], [z]]
|
||
# map (map rows) -- -> [[hh], [hh], [h]] ('h' means 'html')
|
||
# A.intersperse [emptyline] -- -> [[hh], [line], [hh], [line], [h]]
|
||
# A.concat -- -> [h h line h h line h]
|
||
|
||
emptyline = HH.tr_ [ txt_name "", HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [] ]
|
||
|
||
table_content records_ = HH.tbody_ $ map rows records_
|
||
rows rr = if rr.readonly
|
||
then HH.tr [ HP.classes [C.has_background_warning_light] ] $ render_row rr
|
||
else HH.tr_ $ render_row rr
|
||
|
||
render_row :: ResourceRecord -> Array (HH.HTML w i)
|
||
render_row rr =
|
||
case rr.rrtype of
|
||
"SOA" ->
|
||
[ HH.td_ [ HH.text rr.name ]
|
||
, HH.td_ [ HH.text $ show rr.ttl ]
|
||
, HH.td_ [ HH.text $ maybe "" id rr.mname ]
|
||
, HH.td_ [ HH.text $ maybe "" id rr.rname ]
|
||
, HH.td_ [ HH.text $ maybe "" show rr.serial ]
|
||
, HH.td_ [ HH.text $ maybe "" show rr.refresh ]
|
||
, HH.td_ [ HH.text $ maybe "" show rr.retry ]
|
||
, HH.td_ [ HH.text $ maybe "" show rr.expire ]
|
||
, HH.td_ [ HH.text $ maybe "" show rr.minttl ]
|
||
]
|
||
"SRV" ->
|
||
[ HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ maybe "tcp" show rr.protocol ]
|
||
, HH.td_ [ Web.p rr.target ]
|
||
, HH.td_ [ Web.p $ maybe "" show rr.port ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
, HH.td_ [ Web.p $ maybe "" show rr.priority ]
|
||
, HH.td_ [ Web.p $ maybe "" show rr.weight ]
|
||
, if rr.readonly
|
||
then HH.td_ [ Button.btn_readonly ]
|
||
else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
]
|
||
"CAA" ->
|
||
[ HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
] <> case rr.caa of
|
||
Just caa ->
|
||
[ HH.td_ [ Web.p $ show caa.flag ]
|
||
, HH.td_ [ Web.p $ show caa.tag ]
|
||
, HH.td_ [ Web.p caa.value ]
|
||
, if rr.readonly
|
||
then HH.td_ [ Button.btn_readonly ]
|
||
else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
]
|
||
Nothing -> [Web.p "Problem: there is no CAA data." ]
|
||
"SPF" ->
|
||
[ HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
-- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed.
|
||
, HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_mechanism) rr.mechanisms ]
|
||
, HH.td_ [ Web.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_modifier) rr.modifiers ]
|
||
, HH.td_ [ Web.p $ maybe "" fancy_qualifier_display rr.q ]
|
||
, if rr.readonly
|
||
then HH.td_ [ Button.btn_readonly ]
|
||
else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
]
|
||
"DKIM" ->
|
||
[ HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
] <> case rr.dkim of
|
||
Just dkim ->
|
||
[
|
||
-- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DKIM1.
|
||
HH.td_ [ Web.p $ maybe "" show dkim.h ]
|
||
, HH.td_ [ Web.p $ maybe "" show dkim.k ]
|
||
, HH.td_ [ Web.p $ CP.take 20 dkim.p ]
|
||
, HH.td_ [ Web.p $ fromMaybe "" dkim.n ]
|
||
, if rr.readonly
|
||
then HH.td_ [ Button.btn_readonly ]
|
||
else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
]
|
||
Nothing -> [Web.p "Problem: there is no DKIM data." ]
|
||
"DMARC" ->
|
||
[ HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
] <> case rr.dmarc of
|
||
Just dmarc ->
|
||
[
|
||
-- , HH.td_ [ Web.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DMARC1.
|
||
HH.td_ [ Web.p $ show dmarc.p ]
|
||
, HH.td_ [ Web.p $ maybe "" show dmarc.sp ]
|
||
, HH.td_ [ Web.p $ maybe "" show dmarc.adkim ]
|
||
, HH.td_ [ Web.p $ maybe "" show dmarc.aspf ]
|
||
, HH.td_ [ Web.p $ maybe "" show dmarc.pct ]
|
||
, HH.td_ [ Web.p $ maybe "" show dmarc.fo ]
|
||
, HH.td_ [ Web.p $ maybe "" show dmarc.ri ]
|
||
-- TODO? rua & ruf
|
||
-- , HH.td_ [ ] -- For now, assume AFRF.
|
||
, if rr.readonly
|
||
then HH.td_ [ Button.btn_readonly ]
|
||
else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
]
|
||
Nothing -> [Web.p "Problem: there is no DMARC data." ]
|
||
"MX" ->
|
||
[ HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
, HH.td_ [ Web.p $ maybe "" show rr.priority ]
|
||
, HH.td_ [ Web.p rr.target ]
|
||
, if rr.readonly
|
||
then HH.td_ [ Button.btn_readonly ]
|
||
else HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
]
|
||
_ ->
|
||
[ txt_name rr.rrtype
|
||
, HH.td_ [ Web.p rr.name ]
|
||
, HH.td_ [ Web.p $ show rr.ttl ]
|
||
, HH.td_ [ Web.p rr.target ]
|
||
] <> if rr.readonly
|
||
then [ HH.td_ [ Button.btn_readonly ] ]
|
||
else [ HH.td_ [ Button.btn_modify (action_create_or_update_rr rr.rrid), Button.btn_delete (action_delete_rr rr.rrid) ]
|
||
, HH.td_ [ maybe (show_token_or_btn rr) Web.p rr.token ]
|
||
]
|
||
|
||
show_token_or_btn rr =
|
||
case rr.rrtype of
|
||
"A" -> Button.btn_ [C.is_small] "🏁 Ask for a token" (action_new_token rr.rrid)
|
||
"AAAA" -> Button.btn_ [C.is_small] "🏁 Ask for a token" (action_new_token rr.rrid)
|
||
_ -> HH.text ""
|
||
|
||
fancy_qualifier_display :: RR.Qualifier -> String
|
||
fancy_qualifier_display qualifier = "(" <> show_qualifier_char qualifier <> ") " <> show_qualifier qualifier
|
||
|
||
simple_table_header :: forall w i. HH.HTML w i
|
||
simple_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
|
||
, HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
, HH.th_ [ target_header ]
|
||
, HH.th_ [ HH.text "" ]
|
||
, HH.th_ [ token_header ]
|
||
]
|
||
]
|
||
where
|
||
token_header :: HH.HTML w i
|
||
token_header = HH.abbr
|
||
[ HP.title "Tokens are used to update the entry, see the tab: \"Tokens? 🤨\"" ]
|
||
[ HH.text "Token" ]
|
||
|
||
simple_table_header_ro :: forall w i. HH.HTML w i
|
||
simple_table_header_ro
|
||
= HH.thead_ [ HH.tr [ HP.classes [C.has_background_warning_light] ]
|
||
[ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ]
|
||
, HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
, HH.th_ [ target_header ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
|
||
mx_table_header :: forall w i. HH.HTML w i
|
||
mx_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
, HH.th_ [ priority_header ]
|
||
, HH.th_ [ target_header ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
|
||
caa_table_header :: forall w i. HH.HTML w i
|
||
caa_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
, HH.th_ [ HH.text "Flag" ]
|
||
, HH.th_ [ HH.text "Tag" ]
|
||
, HH.th_ [ HH.text "Value" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
|
||
srv_table_header :: forall w i. HH.HTML w i
|
||
srv_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
|
||
, HH.th_ [ protocol_header ]
|
||
, HH.th_ [ target_header ]
|
||
, HH.th_ [ port_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
, HH.th_ [ priority_header ]
|
||
, HH.th_ [ weight_header ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
where
|
||
weight_header :: HH.HTML w i
|
||
weight_header = HH.abbr
|
||
[ HP.title "A relative weight used when multiple servers have the same priority, determining how often they should be used" ]
|
||
[ HH.text "Weight" ]
|
||
|
||
spf_table_header :: forall w i. HH.HTML w i
|
||
spf_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
-- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed.
|
||
, HH.th_ [ srv_mechanisms_header ]
|
||
, HH.th_ [ srv_modifiers_header ]
|
||
, HH.th_ [ srv_default_policy_header ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
where
|
||
srv_mechanisms_header :: HH.HTML w i
|
||
srv_mechanisms_header = HH.abbr
|
||
[ HP.title "Mechanisms specify which mail servers are allowed to send mail for the domain and how to evaluate the sending mail server’s IP address" ]
|
||
[ HH.text "Mechanisms" ]
|
||
srv_modifiers_header :: HH.HTML w i
|
||
srv_modifiers_header = HH.abbr
|
||
[ HP.title "Modifiers provide additional instructions, such as explanations for SPF failures or redirecting SPF checks to another domain" ]
|
||
[ HH.text "Modifiers" ]
|
||
srv_default_policy_header :: HH.HTML w i
|
||
srv_default_policy_header = HH.abbr
|
||
[ HP.title "" ]
|
||
[ HH.text "Default Policy" ]
|
||
|
||
dkim_table_header :: forall w i. HH.HTML w i
|
||
dkim_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
-- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DKIM1.
|
||
, HH.th_ [ HH.text "Hash algo" ]
|
||
, HH.th_ [ HH.text "Signature algo" ]
|
||
, HH.th_ [ HH.text "Public Key" ]
|
||
, HH.th_ [ dkim_notes_header ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
where
|
||
dkim_notes_header :: HH.HTML w i
|
||
dkim_notes_header = HH.abbr
|
||
[ HP.title "Arbitrary string related to this cryptographic material" ]
|
||
[ HH.text "Notes" ]
|
||
|
||
dmarc_table_header :: forall w i. HH.HTML w i
|
||
dmarc_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ name_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
-- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DMARC1.
|
||
, HH.th_ [ dmarc_policy_header ] -- p
|
||
, HH.th_ [ dmarc_subdom_policy_header ] -- sp
|
||
, HH.th_ [ dmarc_dkim_policy_header ] -- adkim
|
||
, HH.th_ [ dmarc_spf_policy_header ] -- aspf
|
||
, HH.th_ [ dmarc_sample_rate_header ] -- pct
|
||
, HH.th_ [ dmarc_report_on_header ] -- fo
|
||
, HH.th_ [ dmarc_report_interval_header ] -- ri
|
||
-- TODO? rua & ruf
|
||
-- , HH.th_ [ HH.text "Accepted report formats" ] -- For now, assume AFRF.
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
where
|
||
dmarc_policy_header :: HH.HTML w i
|
||
dmarc_policy_header = HH.abbr
|
||
[ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
|
||
[ HH.text "Policy" ]
|
||
dmarc_subdom_policy_header :: HH.HTML w i
|
||
dmarc_subdom_policy_header = HH.abbr
|
||
[ HP.title "How to handle email when SPF and DKIM aren't valid?" ]
|
||
[ HH.text "Subdomain Policy" ]
|
||
dmarc_dkim_policy_header :: HH.HTML w i
|
||
dmarc_dkim_policy_header = HH.abbr
|
||
[ HP.title "What should be considered acceptable to do with an email not conforming with DKIM" ]
|
||
[ HH.text "DKIM Policy" ]
|
||
dmarc_spf_policy_header :: HH.HTML w i
|
||
dmarc_spf_policy_header = HH.abbr
|
||
[ HP.title "What should be considered acceptable to do with an email not conforming with SPF" ]
|
||
[ HH.text "SPF Policy" ]
|
||
dmarc_sample_rate_header :: HH.HTML w i
|
||
dmarc_sample_rate_header = HH.abbr
|
||
[ HP.title "Percentage of messages subjected to the requested policy [0-100]" ]
|
||
[ HH.text "Sample Rate" ]
|
||
dmarc_report_on_header :: HH.HTML w i
|
||
dmarc_report_on_header = HH.abbr
|
||
[ HP.title "What error should be reported? DKIM, SPF, Both, Any or None?" ]
|
||
[ HH.text "Report on" ]
|
||
dmarc_report_interval_header :: HH.HTML w i
|
||
dmarc_report_interval_header = HH.abbr
|
||
[ HP.title "Minimal duration between two DMARC reports (in seconds)" ]
|
||
[ HH.text "Report interval" ]
|
||
|
||
soa_table_header :: forall w i. HH.HTML w i
|
||
soa_table_header
|
||
= HH.thead_ [ HH.tr [ HP.classes [C.has_background_warning_light] ]
|
||
[ HH.th_ [ name_soa_header ]
|
||
, HH.th_ [ ttl_header ]
|
||
, HH.th_ [ mname_soa_header ]
|
||
, HH.th_ [ rname_soa_header ]
|
||
, HH.th_ [ serial_soa_header ]
|
||
, HH.th_ [ refresh_soa_header ]
|
||
, HH.th_ [ retry_soa_header ]
|
||
, HH.th_ [ expire_soa_header ]
|
||
, HH.th_ [ minttl_soa_header ]
|
||
]
|
||
]
|
||
where
|
||
name_soa_header :: HH.HTML w i
|
||
name_soa_header = HH.abbr
|
||
[ HP.title "Your actual domain name (technical term: \"fully qualified domain name\")." ]
|
||
[ HH.text "Name" ]
|
||
mname_soa_header :: HH.HTML w i
|
||
mname_soa_header = HH.abbr
|
||
[ HP.title "Domain name of the primary authoritative DNS server for the zone (SOA \"MNAME\" field)." ]
|
||
[ HH.text "Primary NS" ]
|
||
rname_soa_header :: HH.HTML w i
|
||
rname_soa_header = HH.abbr
|
||
[ HP.title "The email address of the person responsible for managing the zone (the \"@\" is replaced by \".\" for some reason). This is the SOA \"RNAME\" field." ]
|
||
[ HH.text "Contact" ]
|
||
serial_soa_header :: HH.HTML w i
|
||
serial_soa_header = HH.abbr
|
||
[ HP.title "A number that is incremented every time the zone is updated. Secondary DNS servers use this number to check for updates." ]
|
||
[ HH.text "Serial" ]
|
||
refresh_soa_header :: HH.HTML w i
|
||
refresh_soa_header = HH.abbr
|
||
[ HP.title "The interval (in seconds) at which secondary DNS servers should check the primary server for changes to the zone." ]
|
||
[ HH.text "Refresh" ]
|
||
expire_soa_header :: HH.HTML w i
|
||
expire_soa_header = HH.abbr
|
||
[ HP.title "The time in seconds that secondary DNS servers will keep the zone data before discarding it if they cannot contact the primary server." ]
|
||
[ HH.text "Expire" ]
|
||
minttl_soa_header :: HH.HTML w i
|
||
minttl_soa_header = HH.abbr
|
||
[ HP.title "The minimum time (in seconds) that other DNS servers should cache negative responses (e.g., for non-existent domain names)." ]
|
||
[ HH.text "Minimum TTL" ]
|
||
retry_soa_header :: HH.HTML w i
|
||
retry_soa_header = HH.abbr
|
||
[ HP.title "The time in seconds that secondary servers should wait before retrying a failed attempt to contact the primary DNS server." ]
|
||
[ HH.text "Retry" ]
|
||
|
||
name_header :: forall w i. HH.HTML w i
|
||
name_header = HH.abbr
|
||
[ HP.title "Name of the DNS entry, the fully-qualified-domain-name is <name>.<domain>." ]
|
||
[ HH.text "Name" ]
|
||
|
||
ttl_header :: forall w i. HH.HTML w i
|
||
ttl_header = HH.abbr
|
||
[ HP.title "Time-to-Live, nb seconds before being considered invalid" ]
|
||
[ HH.text "TTL" ]
|
||
|
||
target_header :: forall w i. HH.HTML w i
|
||
target_header = HH.abbr
|
||
[ HP.title "In the DNS jargon, the target means the most important value associated with the entry, for an A entry it would be an IPv4 address, for example" ]
|
||
[ HH.text "Target" ]
|
||
|
||
priority_header :: forall w i. HH.HTML w i
|
||
priority_header = HH.abbr
|
||
[ HP.title "A numeric value that indicates the preference of the server (lower values indicate higher priority)" ]
|
||
[ HH.text "Priority" ]
|
||
|
||
protocol_header :: forall w i. HH.HTML w i
|
||
protocol_header = HH.abbr
|
||
[ HP.title "The related communication protocol, either TCP or UDP (want more? Just ask me)" ]
|
||
[ HH.text "Protocol" ]
|
||
|
||
port_header :: forall w i. HH.HTML w i
|
||
port_header = HH.abbr
|
||
[ HP.title "Related connection port" ]
|
||
[ HH.text "Port" ]
|
||
|
||
display_mechanisms :: forall w i. (Int -> i) -> Array RR.Mechanism -> HH.HTML w i
|
||
display_mechanisms _ [] = Web.p "You don't have any mechanism."
|
||
display_mechanisms action_remove_mechanism ms =
|
||
Web.table [] [ mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms]
|
||
where
|
||
render_mechanism_row :: (Tuple Int RR.Mechanism) -> HH.HTML w i
|
||
render_mechanism_row (Tuple i m) = HH.tr_
|
||
[ txt_name $ maybe "" show_qualifier m.q
|
||
, HH.td_ [ Web.p $ show_mechanism_type m.t ]
|
||
, HH.td_ [ Web.p m.v ]
|
||
, HH.td_ [ Button.alert_btn "x" (action_remove_mechanism i) ]
|
||
]
|
||
mechanism_table_header :: HH.HTML w i
|
||
mechanism_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ]
|
||
, HH.th_ [ HH.text "Type" ]
|
||
, HH.th_ [ HH.text "Value" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
|
||
display_modifiers :: forall w i. (Int -> i) -> Array RR.Modifier -> HH.HTML w i
|
||
display_modifiers _ [] = Web.p "You don't have any modifier."
|
||
display_modifiers action_remove_modifier ms =
|
||
Web.table [] [ modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms]
|
||
where
|
||
render_modifier_row :: (Tuple Int RR.Modifier) -> HH.HTML w i
|
||
render_modifier_row (Tuple i m) = HH.tr_
|
||
[ HH.td_ [ Web.p $ show_modifier_type m.t ]
|
||
, HH.td_ [ Web.p m.v ]
|
||
, HH.td_ [ Button.alert_btn "x" (action_remove_modifier i) ]
|
||
]
|
||
modifier_table_header :: HH.HTML w i
|
||
modifier_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
|
||
, HH.th_ [ HH.text "Value" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|
||
|
||
display_dmarc_mail_addresses :: forall w i. (Int -> i) -> Array DMARC.DMARCURI -> HH.HTML w i
|
||
display_dmarc_mail_addresses f ms =
|
||
Web.table [] [ dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms]
|
||
where
|
||
render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i
|
||
render_dmarcuri_row (Tuple i m) = HH.tr_
|
||
[ HH.td_ [ Web.p m.mail ]
|
||
, HH.td_ [ Web.p $ maybe "(no size limit)" show m.limit ]
|
||
, HH.td_ [ Button.alert_btn "x" (f i) ]
|
||
]
|
||
dmarc_dmarcuri_table_header :: HH.HTML w i
|
||
dmarc_dmarcuri_table_header
|
||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ]
|
||
, HH.th_ [ HH.text "Report size limit" ]
|
||
, HH.th_ [ HH.text "" ]
|
||
]
|
||
]
|