WIP Validation, CANNOT COMPILE ATM.
parent
bbc258bc58
commit
28c1d56b6f
|
@ -16,7 +16,10 @@ import URI.Host.IPv4Address as IPv4
|
|||
import URI.Host.IPv6Address as IPv6
|
||||
|
||||
import App.RR
|
||||
import App.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
import App.ResourceRecord (ResourceRecord)
|
||||
import GenericParser.Parser as G
|
||||
import GenericParser.IPAddress as IPAddress
|
||||
|
||||
--andThenDrop :: forall errors a b. V errors a -> V errors b -> V errors b
|
||||
-- andThenDrop f1 f2 = f1 !> (\ _ -> f2)
|
||||
|
@ -38,6 +41,14 @@ data Attribute
|
|||
|
||||
derive instance eqAttribute :: Eq Attribute
|
||||
|
||||
data ValidationError
|
||||
= UNKNOWN
|
||||
| VEIPv4 (G.Error IPAddress.IPv4Error)
|
||||
| VEIPv6 (G.Error IPAddress.IPv6Error)
|
||||
|
||||
type AVErrors = Array ValidationError
|
||||
|
||||
type NErrors v = Array (Tuple Attribute v)
|
||||
type Errors = Array (Tuple Attribute String)
|
||||
|
||||
-- | Totally garbage values at the moment. Please fix. **TODO**
|
||||
|
@ -398,3 +409,23 @@ toRR_srv :: Int -> Boolean -> String -> String -> Int -> String -> Int -> Int ->
|
|||
toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
|
||||
= toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight)
|
||||
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
-- | `parse` allows to run any parser based on `GenericParser` and provide a validation error.
|
||||
-- | The actual validation error contains the parser's error including the position.
|
||||
parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> ValidationError) -> V AVErrors v
|
||||
parse (G.Parser p) str c = case p { string: str, position: 0 } of
|
||||
Left x -> invalid $ [c x]
|
||||
Right x -> pure x.result
|
||||
|
||||
validationA :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord
|
||||
validationA form = ado
|
||||
-- name <- validate_name form.name
|
||||
-- ttl <- validate_ttl form.ttl
|
||||
target <- parse IPAddress.ipv4 form.target VEIPv4
|
||||
-- in toRR_basic form.rrid form.readonly "A" name ttl target
|
||||
in toRR_basic form.rrid form.readonly "A" form.name form.ttl target
|
||||
|
||||
validation :: forall l. SRVRR (|l) -> AcceptedRRTypes -> Either AVErrors ResourceRecord
|
||||
validation entry t = case t of
|
||||
A -> toEither <<< validationA entry
|
||||
_ -> invalid $ UNKNOWN
|
||||
|
|
|
@ -47,6 +47,7 @@ import Halogen.HTML.Properties as HP
|
|||
import Bulma as Bulma
|
||||
import CSSClasses as C
|
||||
|
||||
import App.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||
import App.RR (MXRR, Port, Priority, Protocol, RRId, RecordName, RecordTarget, SOARR, SRVRR, SimpleRR, TTL, Weight
|
||||
, defaultResourceA, defaultResourceMX, defaultResourceSRV)
|
||||
import App.ResourceRecord (ResourceRecord)
|
||||
|
@ -55,16 +56,8 @@ import App.LogMessage (LogMessage(..))
|
|||
import App.Messages.DNSManagerDaemon as DNSManager
|
||||
import App.Validation as Validation
|
||||
|
||||
-- | `App.ZoneInterface` accepts to add a few new entry types.
|
||||
-- | Each entry type has a specific form in a modal, with relevant and dedicated information.
|
||||
data AcceptedRRTypes
|
||||
= A
|
||||
| AAAA
|
||||
| TXT
|
||||
| CNAME
|
||||
| NS
|
||||
| MX
|
||||
| SRV
|
||||
id :: forall a. a -> a
|
||||
id x = x
|
||||
|
||||
-- | `App.ZoneInterface` can send messages through websocket interface
|
||||
-- | connected to dnsmanagerd. See `App.WS`.
|
||||
|
@ -176,6 +169,7 @@ type State =
|
|||
|
||||
-- Unique RR form.
|
||||
, _newRR :: (SRVRR ()) -- SRVRR contains all relevant information for every RR.
|
||||
-- , _newRR_errors :: Hash.HashMap RRId Validation.Errors
|
||||
|
||||
-- potential future entries
|
||||
, _newSRR :: (SimpleRR ())
|
||||
|
@ -474,7 +468,7 @@ handleAction = case _ of
|
|||
case form of
|
||||
A -> do
|
||||
state <- H.get
|
||||
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "A"
|
||||
try_add_new_entry2 state._domain (Validation.validateSRR state._newRR) id A
|
||||
AAAA -> do
|
||||
state <- H.get
|
||||
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "AAAA"
|
||||
|
@ -595,6 +589,27 @@ handleAction = case _ of
|
|||
H.raise $ Log $ SimpleLog (" => " <> val)
|
||||
|
||||
where
|
||||
try_add_new_entry2
|
||||
:: forall v.
|
||||
String
|
||||
-> Either (Validation.NErrors v) ResourceRecord
|
||||
-> (v -> String)
|
||||
-> AcceptedRRTypes
|
||||
-> H.HalogenM State Action () Output m Unit
|
||||
try_add_new_entry2 d v e t = case v of
|
||||
Left actual_errors -> do
|
||||
H.raise $ Log $ SimpleLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:"
|
||||
-- TODO: FIXME: currently this just prints the errors in the logs (page footer).
|
||||
-- Soon, this will have to be in the form directly.
|
||||
loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> e v) $ map snd actual_errors
|
||||
|
||||
Right newrr -> do
|
||||
H.raise $ Log $ SimpleLog $ "Add new " <> show t
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
$ DNSManager.MkAddRR { domain: d, rr: newrr }
|
||||
H.raise $ MessageToSend message
|
||||
|
||||
try_add_new_entry
|
||||
:: String
|
||||
-> Either Validation.Errors ResourceRecord
|
||||
|
|
Loading…
Reference in New Issue