diff --git a/src/App/AcceptedRRTypes.purs b/src/App/AcceptedRRTypes.purs index aa0cb98..3eaeca2 100644 --- a/src/App/AcceptedRRTypes.purs +++ b/src/App/AcceptedRRTypes.purs @@ -16,6 +16,7 @@ data AcceptedRRTypes | MX | SRV | SPF + | DKIM derive instance genericMyADT :: Generic AcceptedRRTypes _ diff --git a/src/App/DKIM.purs b/src/App/DKIM.purs new file mode 100644 index 0000000..aeb15d8 --- /dev/null +++ b/src/App/DKIM.purs @@ -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" diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs index eb3c33f..b79fb84 100644 --- a/src/App/ResourceRecord.purs +++ b/src/App/ResourceRecord.purs @@ -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 diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 5f86385..2be0000 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -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 diff --git a/src/Bulma.purs b/src/Bulma.purs index 1663715..3282ee6 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -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 ]