Compiles again, but not everything will work (still validations to do!)
parent
15eb7d9acb
commit
418f6d74cd
|
|
@ -102,7 +102,7 @@ validateA form = ado
|
|||
name <- validate_name form.name
|
||||
ttl <- validate_ttl form.ttl
|
||||
target <- validate_target form.target
|
||||
in pure $ toRR_basic form.rrid form.readonly "A" name ttl target
|
||||
in toRR_basic form.rrid form.readonly "A" name ttl target
|
||||
|
||||
validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
|
||||
validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"]
|
||||
|
|
@ -117,8 +117,8 @@ validateMX _ = invalid [Tuple NotAnAttribute "validation not implemented"]
|
|||
validateSRV :: forall l. SRVRR (|l) -> V Errors ResourceRecord
|
||||
validateSRV _ = invalid [Tuple NotAnAttribute "validation not implemented"]
|
||||
|
||||
validateSRR :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
|
||||
validateSRR form = case form.rrtype of
|
||||
validateSRR_ :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
|
||||
validateSRR_ form = case form.rrtype of
|
||||
"A" -> validateA form
|
||||
"AAAA" -> validateAAAA form
|
||||
"TXT" -> validateTXT form
|
||||
|
|
@ -126,19 +126,30 @@ validateSRR form = case form.rrtype of
|
|||
"NS" -> validateNS form
|
||||
_ -> invalid [Tuple NotAnAttribute $ "invalid type: " <> form.rrtype]
|
||||
|
||||
validateMXRR :: forall l. MXRR (|l) -> V Errors ResourceRecord
|
||||
validateMXRR form = case form.rrtype of
|
||||
validateMXRR_ :: forall l. MXRR (|l) -> V Errors ResourceRecord
|
||||
validateMXRR_ form = case form.rrtype of
|
||||
"MX" -> validateMX form
|
||||
_ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: MX): " <> form.rrtype]
|
||||
|
||||
validateSRVRR :: forall l. SRVRR (|l) -> V Errors ResourceRecord
|
||||
validateSRVRR form = case form.rrtype of
|
||||
validateSRVRR_ :: forall l. SRVRR (|l) -> V Errors ResourceRecord
|
||||
validateSRVRR_ form = case form.rrtype of
|
||||
"SRV" -> validateSRV form
|
||||
_ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: SRV): " <> form.rrtype]
|
||||
|
||||
|
||||
-- TODO: whole zone validations.
|
||||
validateSRR :: forall l. SimpleRR (|l) -> Either Errors ResourceRecord
|
||||
validateSRR = toEither <<< validateSRR_
|
||||
|
||||
validateMXRR :: forall l. MXRR (|l) -> Either Errors ResourceRecord
|
||||
validateMXRR = toEither <<< validateMXRR_
|
||||
|
||||
validateSRVRR :: forall l. SRVRR (|l) -> Either Errors ResourceRecord
|
||||
validateSRVRR = toEither <<< validateSRVRR_
|
||||
|
||||
-- type ZoneErrors = Array (Tuple Errors RRId)
|
||||
-- type Zone l = String -> Array (SimpleRR (|l)) -> Array (MXRR (|l)) -> Array (SRVRR (|l))
|
||||
|
||||
-- validateZone :: forall l. Zone l -> Either Errors
|
||||
|
||||
-- Functions handling network-related structures (ResourceRecord).
|
||||
|
||||
|
|
|
|||
|
|
@ -42,6 +42,7 @@ import App.ResourceRecord (ResourceRecord)
|
|||
|
||||
import App.LogMessage (LogMessage(..))
|
||||
import App.Messages.DNSManagerDaemon as DNSManager
|
||||
import App.Validation as Validation
|
||||
|
||||
-- | `App.ZoneInterface` can send messages through websocket interface
|
||||
-- | connected to dnsmanagerd. See `App.WS`.
|
||||
|
|
@ -324,30 +325,36 @@ handleAction = case _ of
|
|||
AddRR form -> case form of
|
||||
Add_SRR -> do
|
||||
state <- H.get
|
||||
let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry
|
||||
-- H.raise $ Log $ SimpleLog $ "Add new simple RR: " <> show state._current_entry.rrtype
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
case Validation.validateSRR state._current_entry of
|
||||
Left _ -> H.raise $ Log $ SimpleLog "Cannot add this simple RR, some errors occured in the record"
|
||||
Right newrr -> do
|
||||
H.raise $ Log $ SimpleLog "Add new simple RR"
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
Add_MXRR -> do
|
||||
state <- H.get
|
||||
let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
|
||||
-- H.raise $ Log $ SimpleLog "Add new MX"
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
case Validation.validateMXRR state._current_entry_mx of
|
||||
Left _ -> H.raise $ Log $ SimpleLog "Cannot add this MX RR, some errors occured in the record"
|
||||
Right newrr -> do
|
||||
H.raise $ Log $ SimpleLog "Add new MX"
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
Add_SRVRR -> do
|
||||
state <- H.get
|
||||
let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv
|
||||
-- H.raise $ Log $ SimpleLog "Add new SRV"
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
case Validation.validateSRVRR state._current_entry_srv of
|
||||
Left _ -> H.raise $ Log $ SimpleLog "Cannot add this SRV RR, some errors occured in the record"
|
||||
Right newrr -> do
|
||||
H.raise $ Log $ SimpleLog "Add new SRV"
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
UpdateLocalForm rr_id form -> case form of
|
||||
Update_Local_Form_SRR rr_update -> case rr_update of
|
||||
|
|
@ -427,12 +434,14 @@ handleAction = case _ of
|
|||
case maybe_local_rr of
|
||||
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find simple RR rrid: " <> show local_rr_id
|
||||
Just local_rr -> do
|
||||
let rr = fromLocalSimpleRRRepresentationToResourceRecord local_rr
|
||||
-- H.raise $ Log $ SimpleLog $ "Save a simple RR: " <> show local_rr_id
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._current_domain, rr: rr }
|
||||
H.raise $ MessageToSend message
|
||||
case Validation.validateSRR local_rr of
|
||||
Left _ -> H.raise $ Log $ SimpleLog "Cannot update this simple RR, some errors occured in the record"
|
||||
Right rr -> do
|
||||
H.raise $ Log $ SimpleLog $ "Save a simple RR: " <> show local_rr_id
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._current_domain, rr: rr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
SyncMXRR local_rr_id -> do
|
||||
state <- H.get
|
||||
|
|
@ -440,12 +449,14 @@ handleAction = case _ of
|
|||
case maybe_local_rr of
|
||||
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find MX RR rrid: " <> show local_rr_id
|
||||
Just local_rr -> do
|
||||
let rr = fromLocalMXRRRepresentationToResourceRecord local_rr
|
||||
-- H.raise $ Log $ SimpleLog $ "Save a MX RR: " <> show local_rr_id
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._current_domain, rr: rr }
|
||||
H.raise $ MessageToSend message
|
||||
case Validation.validateMXRR local_rr of
|
||||
Left _ -> H.raise $ Log $ SimpleLog "Cannot update this MX RR, some errors occured in the record"
|
||||
Right rr -> do
|
||||
-- H.raise $ Log $ SimpleLog $ "Save a MX RR: " <> show local_rr_id
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._current_domain, rr: rr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
SyncSRVRR local_rr_id -> do
|
||||
state <- H.get
|
||||
|
|
@ -453,12 +464,14 @@ handleAction = case _ of
|
|||
case maybe_local_rr of
|
||||
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find SRV RR rrid: " <> show local_rr_id
|
||||
Just local_rr -> do
|
||||
let rr = fromLocalSRVRRepresentationToResourceRecord local_rr
|
||||
-- H.raise $ Log $ SimpleLog $ "Save a SRV RR: " <> show local_rr_id
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._current_domain, rr: rr }
|
||||
H.raise $ MessageToSend message
|
||||
case Validation.validateSRVRR local_rr of
|
||||
Left _ -> H.raise $ Log $ SimpleLog "Cannot update this SRV RR, some errors occured in the record"
|
||||
Right rr -> do
|
||||
-- H.raise $ Log $ SimpleLog $ "Save a SRV RR: " <> show local_rr_id
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkUpdateRR { domain: state._current_domain, rr: rr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
RemoveRR rr_id -> do
|
||||
{ _current_domain } <- H.get
|
||||
|
|
|
|||
Loading…
Reference in New Issue