WIP: DKIM.

src/App/AcceptedRRTypes.purs

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

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"

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
+import App.DKIM as DKIM
-type CryptoHash = String
-type Signature = String
-type Algorithm = String
-type Selector = String
-type Time = Int
 
 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
-    --, dkim :: Maybe 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

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

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 ]