From f261e836b4b726762916eda36eaa84749b107cd7 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Fri, 14 Jul 2023 03:08:44 +0200
Subject: [PATCH] Let's try some parsing.

---
 spago.dhall             |  1 +
 src/App/Validation.purs | 48 ++++++++++++++++++++++++++++-------------
 2 files changed, 34 insertions(+), 15 deletions(-)

diff --git a/spago.dhall b/spago.dhall
index b262abd..8916dcb 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -30,6 +30,7 @@
   , "transformers"
   , "tuples"
   , "uint"
+  , "uri"
   , "validation"
   , "web-encoding"
   , "web-events"
diff --git a/src/App/Validation.purs b/src/App/Validation.purs
index d00fd1b..3bf2fab 100644
--- a/src/App/Validation.purs
+++ b/src/App/Validation.purs
@@ -4,6 +4,7 @@ import Prelude (apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=),
 
 import Data.Validation.Semigroup (V, andThen, invalid, toEither)
 -- import Data.Array as A
+import Parsing (runParser)
 import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
 import Data.Tuple (Tuple(..))
@@ -11,6 +12,7 @@ import Data.String.Regex as R
 import Data.String.Regex.Flags as RF
 import Data.String as S
 import Data.Int (fromString)
+import URI.Host.IPv4Address as IPv4
 
 import App.RR
 import App.ResourceRecord (ResourceRecord)
@@ -46,7 +48,9 @@ target_max_len :: Int
 target_max_len = 50
 name_format :: String
 name_format = "[a-zA-Z]+"
--- name_format = "[a-zA-Z][a-zA-Z0-9_-]*"
+--name_format = "[a-zA-Z][a-zA-Z0-9_-]*"
+--target_A_format :: String
+--target_A_format = "[1-9][][a-zA-Z]+"
 
 -- Basic tools for validation.
 
@@ -60,8 +64,15 @@ lengthIsBetween field minlen maxlen value
     valid_condition = actual_len >= minlen && actual_len <= maxlen
     error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
 
-matches :: Attribute -> R.Regex -> String -> V Errors String
-matches field regex value
+-- | `matches` is a simple format verification based on regex parsing.
+-- | The regex is the last paramater so the verification code can be written this way:
+-- |
+-- | ```
+-- | verify_regex Name name_format
+-- | !> matches Name name
+-- | ```
+matches :: Attribute -> String -> R.Regex -> V Errors String
+matches field value regex
   | R.test regex value = pure value
   | otherwise          = invalid [Tuple field "unacceptable format"]
 
@@ -78,29 +89,36 @@ validate_integer field string
       Nothing -> invalid [Tuple field "not an integer"]
       Just i  -> pure i
 
-xx :: forall y a. y -> Array a -> y
-xx f _ = f
+verify_regex :: Attribute -> String -> String -> V Errors R.Regex
+verify_regex field str _
+  = case R.regex str RF.unicode of
+      Left error_string -> invalid [Tuple field $ "error in regex: " <> error_string]
+      Right regex       -> pure regex
+
+verify_ipv4 :: Attribute -> String -> V Errors String
+verify_ipv4 field str = case runParser str IPv4.parser of
+  Left _ -> invalid [Tuple field "cannot parse this IPv4"]
+  Right _ -> pure str
 
 -- Field-related validations.
 
 validate_name :: String -> V Errors String
-validate_name name
-  = case R.regex name_format RF.unicode of
-      Left error_string -> invalid [Tuple NotAnAttribute $ "error in name regex: " <> error_string]
-      Right regex       -> verify_length name !> (matches Name regex)
-    where
-      verify_length = lengthIsBetween Name name_min_len name_max_len
+validate_name name = verify_length name !> verify_regex Name name_format !> (matches Name name)
+  where
+    verify_length = lengthIsBetween Name name_min_len name_max_len
 
 validate_ttl :: String -> V Errors Int
 validate_ttl str_ttl
-  = is_int str_ttl !> (intBetween TTL min_ttl max_ttl) !> pure
+  = is_int str_ttl !> right_range !> pure
   where
     is_int = validate_integer TTL
+    right_range = intBetween TTL min_ttl max_ttl
 
-validate_target :: String -> V Errors String
-validate_target target = verify_length target !> pure
+validate_target_A :: String -> V Errors String
+validate_target_A target = verify_length target !> verify_format !> pure
   where
     verify_length = lengthIsBetween Target target_min_len target_max_len
+    verify_format = verify_ipv4 Target
 
 -- Resource-related validations.
 
@@ -108,7 +126,7 @@ validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
 validateA form = ado
   name   <- validate_name   form.name
   ttl    <- validate_ttl    form.ttl
-  target <- validate_target form.target
+  target <- validate_target_A form.target
   in toRR_basic form.rrid form.readonly "A" name ttl target
 
 validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord