karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

WIP: DKIM.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-03-08 02:33:32 +01:00
parent 74f5718f99
commit e039daa4ac
5 changed files with 179 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/App/AcceptedRRTypes.purs
View File

@ -16,6 +16,7 @@ data AcceptedRRTypes
| MX
| SRV
| SPF
| DKIM
derive instance genericMyADT :: Generic AcceptedRRTypes _

82
src/App/DKIM.purs Normal file
View File

@ -0,0 +1,82 @@
module App.DKIM where
import Data.Maybe (Maybe(..))
import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR
type PublicKey = String
type DKIM
= { v :: Maybe Version -- v= "DKIM1", entirely optional (for now, even ignored).
, k :: Maybe SignatureAlgorithm -- k= Key type (optional, default is "rsa").
, h :: Maybe HashingAlgorithm -- h= hash algorigthm (optional, "sha1" or "sha256" from RFC6376)
, p :: PublicKey -- p= Public-key data (base64; REQUIRED).
-- The syntax and semantics of this tag value before being
-- encoded in base64 are defined by the "k=" tag.
, n :: Maybe String -- n= Notes that might be of interest to a human (optional)
}
codec :: JsonCodec DKIM
codec = CA.object "DKIM"
(CAR.record
{ v: CAR.optional codecVersion
, k: CAR.optional codecSignatureAlgorithm
, h: CAR.optional codecHashingAlgorithm
, p: CA.string
, n: CAR.optional CA.string
})
-- RFC6376 section 3.6.2.1
-- All DKIM keys are stored in a subdomain named "_domainkey". Given a
-- DKIM-Signature field with a "d=" tag of "example.com" and an "s=" tag
-- of "foo.bar", the DNS query will be for
-- "foo.bar._domainkey.example.com".
data HashingAlgorithm = SHA1 | SHA256
-- | Codec for just encoding a single value of type `HashingAlgorithm`.
codecHashingAlgorithm :: CA.JsonCodec HashingAlgorithm
codecHashingAlgorithm = CA.prismaticCodec "HashingAlgorithm" str_to_hashing_algorithm show_hashing_algorithm CA.string
str_to_hashing_algorithm :: String -> Maybe HashingAlgorithm
str_to_hashing_algorithm = case _ of
"sha1" -> Just SHA1
"sha256" -> Just SHA256
_ -> Nothing
show_hashing_algorithm :: HashingAlgorithm -> String
show_hashing_algorithm = case _ of
SHA1 -> "sha1"
SHA256 -> "sha256"
data SignatureAlgorithm = RSA
-- | Codec for just encoding a single value of type `SignatureAlgorithm`.
codecSignatureAlgorithm :: CA.JsonCodec SignatureAlgorithm
codecSignatureAlgorithm = CA.prismaticCodec "SignatureAlgorithm" str_to_signature_algorithm show_signature_algorithm CA.string
str_to_signature_algorithm :: String -> Maybe SignatureAlgorithm
str_to_signature_algorithm = case _ of
"rsa" -> Just RSA
_ -> Nothing
show_signature_algorithm :: SignatureAlgorithm -> String
show_signature_algorithm = case _ of
RSA -> "rsa"
data Version = DKIM1
-- | Codec for just encoding a single value of type `Version`.
codecVersion :: CA.JsonCodec Version
codecVersion = CA.prismaticCodec "Version" str_to_version show_version CA.string
str_to_version :: String -> Maybe Version
str_to_version = case _ of
"dkim1" -> Just DKIM1
_ -> Nothing
show_version :: Version -> String
show_version = case _ of
DKIM1 -> "dkim1"

38
src/App/ResourceRecord.purs
View File

@ -8,12 +8,7 @@ import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR
type PubKey = String
type CryptoHash = String
type Signature = String
type Algorithm = String
type Selector = String
type Time = Int
import App.DKIM as DKIM
type ResourceRecord
= { rrtype :: String
@ -46,35 +41,11 @@ type ResourceRecord
, modifiers :: Maybe (Array Modifier)
, q :: Maybe Qualifier -- Qualifier for default mechanism (`all`).
-- DKIM is so complex, it deserves its own type.
--, dkim :: Maybe DKIM
, dkim :: Maybe DKIM.DKIM
-- TODO: DMARC specific entries.
}
-- DKIM specific entries.
type DKIM
= { v :: Maybe Int -- Default: 1
, a :: Maybe Algorithm -- TODO: (required), signing algorithm (example: `rsa-sha256`)
, d :: Maybe String -- TODO: (required), Signing Domain Identifier (SDID) (example: `netlib.re`)
, s :: Maybe Selector -- TODO: (required), selector (name of the DNS TXT entry for DKIM, such as `baguette` for `_baguette._dkim.netlib.re`)
, c :: Maybe Algorithm -- TODO: (optional), canonicalization algorithm(s) for header and body (ex: "relaxed/simple")
, q :: Maybe String -- TODO: (optional), default query method (example: `dns/txt`)
, i :: Maybe String -- TODO: (optional), Agent or User Identifier (AUID) (in practice, an email address)
, t :: Maybe Time -- TODO: (recommended), signature timestamp (time = number, such as `1117574938`)
, x :: Maybe Time -- TODO: (recommended), expire time (time = number, such as `1117574938`)
, l :: Maybe Int -- TODO: (optional), body length (such as `200`)
, h :: Maybe String -- TODO: (required), header fields - list of those that have been signed
, z :: Maybe String -- TODO: (optional), header fields - copy of selected header fields and values
, bh :: Maybe CryptoHash -- TODO: (required), body hash
, b :: Maybe Signature -- TODO: (required), signature of headers and body
}
-- h=from:to:subject:date:keywords:keywords;
-- z=From:foo@eng.example.net|To:joe@example.com|
-- Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700;
-- bh=MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI=;
-- b=dzdVyOfAKCdLXdJOc9G2q8LoXSlEniSbav+yuU4zGeeruD00lszZVoG4ZHRNiYzR
codec :: JsonCodec ResourceRecord
codec = CA.object "ResourceRecord"
(CAR.record
@ -107,7 +78,8 @@ codec = CA.object "ResourceRecord"
, mechanisms: CAR.optional (CA.array codecMechanism)
, modifiers: CAR.optional (CA.array codecModifier)
, q: CAR.optional codecQualifier
--, dkim: CAR.optional codecDKIM
, dkim: CAR.optional DKIM.codec
})
type Mechanism
@ -246,7 +218,7 @@ emptyRR
, modifiers: Nothing
, q: Nothing
--, dkim: Nothing
, dkim: Nothing
}
data Qualifier = Pass | Neutral | SoftFail | HardFail

88
src/App/ZoneInterface.purs
View File

@ -23,6 +23,7 @@ import Prelude (Unit, unit, void
, not, comparing, discard, map, show
, (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#))
import Data.Array as A
import Data.Int (fromString)
import Data.Tuple (Tuple(..))
@ -49,6 +50,7 @@ import App.ResourceRecord (ResourceRecord, emptyRR
, all_qualifiers
, mechanism_types, qualifier_types, modifier_types)
import App.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
import App.DKIM (show_hashing_algorithm, show_signature_algorithm)
import App.DisplayErrors (error_to_paragraph)
@ -184,7 +186,7 @@ show_accepted_type = case _ of
MX -> "MX"
SRV -> "SRV"
SPF -> "SPF"
--DKIM -> "DKIM"
DKIM -> "DKIM"
string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
string_to_acceptedtype str = case str of
@ -196,7 +198,7 @@ string_to_acceptedtype str = case str of
"MX" -> Just MX
"SRV" -> Just SRV
"SPF" -> Just SPF
--"DKIM" -> Just DKIM
"DKIM" -> Just DKIM
_ -> Nothing
type State =
@ -213,6 +215,8 @@ type State =
-- Unique RR form.
, _currentRR :: ResourceRecord
, _currentRR_errors :: Array Validation.Error
-- SPF details.
, spf_mechanism_q :: String
, spf_mechanism_t :: String
, spf_mechanism_v :: String
@ -319,7 +323,7 @@ render state
"MX" -> template modal_content_mx (foot_content MX)
"SRV" -> template modal_content_srv (foot_content SRV)
"SPF" -> template modal_content_spf (foot_content SPF)
--"DKIM" -> template modal_content_dkim (foot_content DKIM)
"DKIM" -> template modal_content_dkim (foot_content DKIM)
_ -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype
where
-- DRY
@ -440,6 +444,49 @@ render state
, Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
]
]
modal_content_dkim :: Array (HH.HTML w Action)
modal_content_dkim =
[ Bulma.p "HELLO THIS IS Work-In-Progress. 😂"]
---- [ Bulma.div_content [Bulma.explanation Explanations.dkim_introduction]
--[ render_errors
--, Bulma.input_with_side_text "domainDKIM" "Name" "Let this alone."
-- (updateForm Field_Domain)
-- state._currentRR.name
-- display_domain_side
--, Bulma.box_input "ttlDKIM" "TTL" "600"
-- (updateForm Field_TTL)
-- (show state._currentRR.ttl)
-- should_be_disabled
--, Bulma.hr
--, maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
--, Bulma.box
-- [ Bulma.h3 "New mechanism"
-- , Bulma.selection_field "idMechanismQ" "Policy" DKIM_Mechanism_q qualifier_types state.spf_mechanism_q
-- , Bulma.selection_field "idMechanismT" "Type" DKIM_Mechanism_t mechanism_types state.spf_mechanism_t
-- , Bulma.box_input "valueNewMechanismDKIM" "Value" ""
-- DKIM_Mechanism_v
-- state.spf_mechanism_v
-- should_be_disabled
-- , Bulma.btn "Add" DKIM_Mechanism_Add
-- ]
--, Bulma.hr
--, maybe (Bulma.p "no modifier") display_modifiers state._currentRR.modifiers
--, Bulma.box
-- [ Bulma.h3 "New modifier"
-- , Bulma.selection_field "idModifierT" "Modifier" DKIM_Modifier_t modifier_types state.spf_modifier_t
-- , Bulma.box_input "valueNewModifierDKIM" "Value" ""
-- DKIM_Modifier_v
-- state.spf_modifier_v
-- should_be_disabled
-- , Bulma.btn "Add" DKIM_Modifier_Add
-- ]
--, Bulma.hr
--, Bulma.box
-- [ Bulma.h3 "Default behavior"
-- , Bulma.div_content [Bulma.explanation Explanations.spf_default_behavior]
-- , Bulma.selection DKIM_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
-- ]
--]
display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
@ -494,7 +541,7 @@ handleAction = case _ of
, mechanisms = Just default_mechanisms
, q = Just RR.HardFail
}
--default_rr_DKIM = emptyRR { rrtype = "DKIM", name = "_default._dkim", target = "" }
default_rr_DKIM = emptyRR { rrtype = "DKIM", name = "_default._dkim", target = "" }
case t of
A -> H.modify_ _ { _currentRR = default_rr_A }
@ -505,7 +552,7 @@ handleAction = case _ of
MX -> H.modify_ _ { _currentRR = default_rr_MX }
SRV -> H.modify_ _ { _currentRR = default_rr_SRV }
SPF -> H.modify_ _ { _currentRR = default_rr_SPF }
--DKIM -> H.modify_ _ { _currentRR = default_rr_DKIM }
DKIM -> H.modify_ _ { _currentRR = default_rr_DKIM }
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
Initialize -> do
@ -710,6 +757,7 @@ render_resources records
<> (rr_box tag_mx [] Bulma.mx_table_header table_content all_mx_rr)
<> (rr_box tag_srv [] Bulma.srv_table_header table_content all_srv_rr)
<> (rr_box tag_spf [] Bulma.spf_table_header table_content all_spf_rr)
<> (rr_box tag_dkim [] Bulma.dkim_table_header table_content all_dkim_rr)
<> (rr_box tag_basic_ro bg_color_ro Bulma.simple_table_header_ro table_content_w_seps all_basic_ro_rr)
where
all_basic_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
@ -719,12 +767,14 @@ render_resources records
all_mx_rr = all_XX_rr "MX"
all_srv_rr = all_XX_rr "SRV"
all_spf_rr = all_XX_rr "SPF"
all_dkim_rr = all_XX_rr "DKIM"
tag_soa = tags [tag_ro "SOA", tag_ro "read only"]
tag_basic = tags [tag "Basic RRs (A, AAAA, PTR, NS, TXT)"]
tag_mx = tags [tag "MX"]
tag_srv = tags [tag "SRV"]
tag_spf = tags [tag "SPF"]
tag_dkim = tags [tag "DKIM", tag "work in progress 😂"]
tag_basic_ro = tags [tag_ro "Basic RRs", tag_ro "read only"]
rr_box :: HH.HTML w Action -- box title (type of data)
@ -770,7 +820,7 @@ render_resources records
, HH.td_ [ HH.text $ maybe "" show rr.minttl ]
]
"SRV" ->
[ HH.td_ [ Bulma.p rr.name]
[ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
, HH.td_ [ Bulma.p $ maybe "" id rr.protocol ]
@ -785,7 +835,7 @@ render_resources records
else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
]
"SPF" ->
[ HH.td_ [ Bulma.p rr.name]
[ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
-- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed.
, HH.td_ [ Bulma.p $ maybe "" (A.fold <<< A.intersperse " " <<< map show_mechanism) rr.mechanisms ]
@ -798,8 +848,26 @@ render_resources records
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
]
"DKIM" ->
[ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
] <> case rr.dkim of
Just dkim ->
[
-- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DKIM1.
HH.td_ [ Bulma.p $ maybe "" show_hashing_algorithm dkim.h ]
, HH.td_ [ Bulma.p $ maybe "" show_signature_algorithm dkim.k ]
, HH.td_ [ Bulma.p dkim.p ]
, if rr.readonly
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
, if rr.readonly
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
]
Nothing -> [Bulma.p "Problem: there is no DKIM data." ]
"MX" ->
[ HH.td_ [ Bulma.p rr.name]
[ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
, HH.td_ [ Bulma.p rr.target ]
@ -812,7 +880,7 @@ render_resources records
]
_ ->
[ Bulma.txt_name rr.rrtype
, HH.td_ [ Bulma.p rr.name]
, HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p rr.target ]
] <> if rr.readonly
@ -873,7 +941,7 @@ render_new_records _
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Bulma.level [
Bulma.btn "SPF" (CreateNewRRModal SPF)
--Bulma.btn "DKIM" (CreateNewRRModal DKIM)
, Bulma.btn "DKIM" (CreateNewRRModal DKIM)
, Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC"
] []
, Bulma.hr

13
src/Bulma.purs
View File

@ -137,6 +137,19 @@ spf_table_header
]
]
dkim_table_header :: forall w i. HH.HTML w i
dkim_table_header
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
, HH.th_ [ HH.text "TTL" ]
-- , 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_ [ HH.text "" ]
, HH.th_ [ HH.text "" ]
]
]
soa_table_header :: forall w i. HH.HTML w i
soa_table_header
= HH.thead_ [ HH.tr [ HP.classes C.has_background_warning_light ]