WIP Validation, CANNOT COMPILE ATM.

This commit is contained in:
Philippe Pittoli 2024-02-01 13:27:15 +01:00
parent bbc258bc58
commit 28c1d56b6f
2 changed files with 57 additions and 11 deletions

View File

@ -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

View File

@ -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