Show actual errors.

beta
Philippe Pittoli 2023-07-14 19:33:33 +02:00
parent 9e55254f91
commit b0b0429ace
2 changed files with 33 additions and 17 deletions

View File

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

View File

@ -18,6 +18,7 @@ import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show,
import Data.HashMap as Hash import Data.HashMap as Hash
import Data.Array as A import Data.Array as A
import Data.Tuple (Tuple(..))
import Data.ArrayBuffer.Types (ArrayBuffer) import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..)) import Data.Either (Either(..))
@ -129,9 +130,9 @@ data Action
-- Update an already active entry. -- Update an already active entry.
| UpdateLocalForm RRId Update_Local_Form | UpdateLocalForm RRId Update_Local_Form
| SyncSRR RRId | SaveSRR RRId
| SyncMXRR RRId | SaveMXRR RRId
| SyncSRVRR RRId | SaveSRVRR RRId
| RemoveRR RRId | RemoveRR RRId
@ -410,17 +411,17 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) } H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) }
SyncSRR local_rr_id -> do SaveSRR local_rr_id -> do
state <- H.get state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srr 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" 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 state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._mxrr 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" 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 state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srvrr 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" try_update_entry state._current_domain Validation.validateSRVRR maybe_local_rr "SRV"
@ -428,10 +429,12 @@ handleAction = case _ of
RemoveRR rr_id -> do RemoveRR rr_id -> do
{ _current_domain } <- H.get { _current_domain } <- H.get
H.raise $ Log $ SimpleLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")" H.raise $ Log $ SimpleLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
-- Send a removal message.
message <- H.liftEffect message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id } $ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id }
H.raise $ MessageToSend message H.raise $ MessageToSend message
-- Modal doesn't need to be active anymore.
H.modify_ _ { active_modal = Nothing } H.modify_ _ { active_modal = Nothing }
-- TODO: change the state to indicate problems? -- TODO: change the state to indicate problems?
@ -455,14 +458,18 @@ handleAction = case _ of
try_update_entry d validation v t = case v of try_update_entry d validation v t = case v of
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find " <> t <> " RR with this rrid" Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find " <> t <> " RR with this rrid"
Just local_rr -> do Just local_rr -> do
state <- H.get
case validation local_rr of case validation local_rr of
Left validation_errors -> do Left validation_errors -> do
state <- H.get
let new_error_hash = Hash.insert local_rr.rrid validation_errors state._errors let new_error_hash = Hash.insert local_rr.rrid validation_errors state._errors
H.modify_ _ { _errors = new_error_hash } 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 Right rr -> do
H.raise $ Log $ SimpleLog $ "Save " <> t <> " RR" 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 message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkUpdateRR { domain: d, rr: rr } $ 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!" H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
(DNSManager.MkRRDeleted response) -> do (DNSManager.MkRRDeleted response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!"
-- Remove the resource record.
state <- H.get state <- H.get
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr , _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 (DNSManager.MkZone response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] Zone received!" 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_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_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.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) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
] ]
] <> error_row rr ] <> error_row rr
error_row rr = case Hash.lookup rr.rrid errors of error_row rr = case Hash.lookup rr.rrid errors of
Nothing -> [] Nothing -> []
Just error_array -> [ HH.tr_ $ 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.Name
, HH.td_ $ from_error_array_to_td error_array Validation.TTL , HH.td_ $ from_error_array_to_td error_array Validation.TTL
, HH.td_ $ from_error_array_to_td error_array Validation.Target , HH.td_ $ from_error_array_to_td error_array Validation.Target
@ -671,8 +682,11 @@ render_records errors records
where where
from_error_array_to_td :: Validation.Errors -> Validation.Attribute -> _ from_error_array_to_td :: Validation.Errors -> Validation.Attribute -> _
from_error_array_to_td [] _ = [] from_error_array_to_td [] _ = []
from_error_array_to_td errors attribute from_error_array_to_td errors attribute = case A.uncons errors of
= [ Bulma.p "hello" ] 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) 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_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_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.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) ] , 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_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_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.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) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
] ]