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

Show actual errors.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-14 19:33:33 +02:00
parent 9e55254f91
commit b0b0429ace
2 changed files with 33 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/App/Validation.purs
View File

@ -1,6 +1,6 @@
module App.Validation where
import Prelude (apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=), (<>), (>=))
import Prelude (class Eq, apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=), (<>), (>=))
import Data.Validation.Semigroup (V, andThen, invalid, toEither)
-- import Data.Array as A
@ -36,6 +36,8 @@ data Attribute
| Port
| NotAnAttribute
derive instance eqAttribute :: Eq Attribute
type Errors = Array (Tuple Attribute String)
-- | Totally garbage values at the moment. Please fix. **TODO**
@ -105,8 +107,8 @@ matches field value regex
intBetween :: Attribute -> Int -> Int -> Int -> V Errors Int
intBetween field min max value
| min < value && value < max = pure value
| otherwise = invalid [Tuple field error_message]
| min <= value && value <= max = pure value
| otherwise = invalid [Tuple field error_message]
where
error_message = "acceptable value [" <> show min <> "-" <> show max <> "]"

42
src/App/ZoneInterface.purs
View File

@ -18,6 +18,7 @@ import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show,
import Data.HashMap as Hash
import Data.Array as A
import Data.Tuple (Tuple(..))
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))
@ -129,9 +130,9 @@ data Action
-- Update an already active entry.
| UpdateLocalForm RRId Update_Local_Form
| SyncSRR RRId
| SyncMXRR RRId
| SyncSRVRR RRId
| SaveSRR RRId
| SaveMXRR RRId
| SaveSRVRR RRId
| RemoveRR RRId
@ -410,17 +411,17 @@ handleAction = case _ of
state <- H.get
H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) }
SyncSRR local_rr_id -> do
SaveSRR local_rr_id -> do
state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srr
try_update_entry state._current_domain Validation.validateSRR maybe_local_rr "simple"
SyncMXRR local_rr_id -> do
SaveMXRR local_rr_id -> do
state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._mxrr
try_update_entry state._current_domain Validation.validateMXRR maybe_local_rr "MX"
SyncSRVRR local_rr_id -> do
SaveSRVRR local_rr_id -> do
state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srvrr
try_update_entry state._current_domain Validation.validateSRVRR maybe_local_rr "SRV"
@ -428,10 +429,12 @@ handleAction = case _ of
RemoveRR rr_id -> do
{ _current_domain } <- H.get
H.raise $ Log $ SimpleLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
-- Send a removal message.
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id }
H.raise $ MessageToSend message
-- Modal doesn't need to be active anymore.
H.modify_ _ { active_modal = Nothing }
-- TODO: change the state to indicate problems?
@ -455,14 +458,18 @@ handleAction = case _ of
try_update_entry d validation v t = case v of
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find " <> t <> " RR with this rrid"
Just local_rr -> do
state <- H.get
case validation local_rr of
Left validation_errors -> do
state <- H.get
let new_error_hash = Hash.insert local_rr.rrid validation_errors state._errors
H.modify_ _ { _errors = new_error_hash }
H.raise $ Log $ SimpleLog $ "TODO!!!! Cannot update this " <> t <> " RR, some errors occured in the record"
H.raise $ Log $ SimpleLog $ "Errors in "
<> t
<> " RR! Please fix them before update."
Right rr -> do
H.raise $ Log $ SimpleLog $ "Save " <> t <> " RR"
let new_error_hash = Hash.delete local_rr.rrid state._errors
H.modify_ _ { _errors = new_error_hash }
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkUpdateRR { domain: d, rr: rr }
@ -538,11 +545,15 @@ handleQuery = case _ of
H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
(DNSManager.MkRRDeleted response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
-- Remove the resource record.
state <- H.get
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr
}
-- Remove its possible errors.
let new_error_hash = Hash.delete response.rrid state._errors
H.modify_ _ { _errors = new_error_hash }
(DNSManager.MkZone response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] Zone received!"
@ -653,14 +664,14 @@ render_records errors records
, HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRR <<< Update_SRR_Domain) rr.name rr.valid ]
, HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRR <<< Update_SRR_TTL ) rr.ttl rr.valid ]
, HH.td_ [ Bulma.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRR <<< Update_SRR_Target) rr.target rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncSRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_change (SaveSRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
]
] <> error_row rr
error_row rr = case Hash.lookup rr.rrid errors of
Nothing -> []
Just error_array -> [ HH.tr_ $
[ Bulma.txt_name "ERROR LINE"
[ Bulma.txt_name "-"
, HH.td_ $ from_error_array_to_td error_array Validation.Name
, HH.td_ $ from_error_array_to_td error_array Validation.TTL
, HH.td_ $ from_error_array_to_td error_array Validation.Target
@ -671,8 +682,11 @@ render_records errors records
where
from_error_array_to_td :: Validation.Errors -> Validation.Attribute -> _
from_error_array_to_td [] _ = []
from_error_array_to_td errors attribute
= [ Bulma.p "hello" ]
from_error_array_to_td errors attribute = case A.uncons errors of
Just { head: (Tuple attr err), tail: xs } -> if attr == attribute
then [Bulma.p err]
else from_error_array_to_td xs attribute
Nothing -> []
render_mx_records :: forall (w :: Type) (l :: Row Type)
@ -695,7 +709,7 @@ render_mx_records errors records
, HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid ]
, HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid ]
, HH.td_ [ Bulma.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Target) rr.target rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncMXRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_change (SaveMXRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
]
@ -721,7 +735,7 @@ render_srv_records errors records
, HH.td_ [ Bulma.input_weight ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Weight ) rr.weight rr.valid ]
, HH.td_ [ Bulma.input_port ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Port ) rr.port rr.valid ]
, HH.td_ [ Bulma.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Target ) rr.target rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncSRVRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_change (SaveSRVRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
]