Show actual errors.
parent
9e55254f91
commit
b0b0429ace
|
@ -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,7 +107,7 @@ 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 <> "]"
|
||||||
|
|
|
@ -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) ]
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue