From 5fdbcc6058d137c87d76fa5719cb5e748251e150 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Thu, 13 Jul 2023 19:29:53 +0200
Subject: [PATCH] Fix most errors in the validation module.

---
 src/App/Validation.purs | 59 ++++++++++++++++++++++++++++-------------
 1 file changed, 40 insertions(+), 19 deletions(-)

diff --git a/src/App/Validation.purs b/src/App/Validation.purs
index 6c32a33..0c96da4 100644
--- a/src/App/Validation.purs
+++ b/src/App/Validation.purs
@@ -2,18 +2,21 @@ module App.Validation where
 
 import Prelude
 
+import Data.Validation.Semigroup
 import Data.Array
+import Data.Maybe
 import Data.Tuple (Tuple(..))
-import App.ResourceRecord (ResourceRecord)
 import Data.String.Regex
 import Data.Int (fromString)
 
+import App.RR
+import App.ResourceRecord (ResourceRecord)
+
 data Attribute
   = Name
   | TTL
   | RRType
   | Id
-  | Name
   | Target 
   | Priority
   | Protocol
@@ -23,34 +26,42 @@ data Attribute
 
 type Errors = Array (Tuple Attribute String)
 
+-- | Totally garbage value at the moment. Please fix.
+min_ttl = 30
+max_ttl = 86000
+name_min_len = 1
 name_max_len = 50
+target_min_len = 1
+target_max_len = 50
 name_format = "[a-zA-Z]+"
 -- name_format = "[a-zA-Z][a-zA-Z0-9_-]*"
 
 -- Basic tools for validation.
 
-lengthIsLessThan :: Attribute -> Int -> String -> V Errors String
-lengthIsLessThan field len value
-  | actual_len >= len  = invalid [ Tuple field error_message ]
-  | otherwise         = pure value
+lengthIsBetween :: Attribute -> Int -> Int -> String -> V Errors String
+lengthIsBetween field minlen maxlen value
+  | valid_condition = invalid [ Tuple field error_message ]
+  | otherwise       = pure value
   where
     actual_len = A.length value
-    error_message = "length should be less than " <> show len
-                    <> " but currently is " <> show actual_len
+    valid_condition = actual_len >= minlen && actual_len <= maxlen
+    error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
 
 matches :: Attribute -> Regex -> String -> V Errors String
 matches field regex value
   | test regex value = pure value
   | otherwise        = invalid [Tuple field "unacceptable format"]
 
-between :: Attribute -> Int -> Int -> Int -> V Errors Int
-between field min max value
+intBetween :: Attribute -> Int -> Int -> Int -> V Errors Int
+intBetween field min max value
   | min < value && value < max = pure value
-  | otherwise                  = invalid [Tuple field $ "value should be between " <> show min <> " and " <> show max]
+  | otherwise                  = invalid [Tuple field error_message]
+  where
+    error_message = "acceptable value [" <> show min <> "-" <> show max <> "]"
 
 validate_integer :: Attribute -> String -> V Errors Int
 validate_integer field value
-  = case fromString form.ttl
+  = case fromString form.ttl of
       Nothing -> invalid [Tuple field "not an integer"]
       Just i  -> pure i
 
@@ -58,15 +69,21 @@ validate_integer field value
 
 validate_name :: String -> V Errors String
 validate_name name = ado
-  _ <- lengthIsLessThan Name name_max_len name
-  _ <- matches          Name name_format  name
+  _ <- lengthIsBetween Name name_min_len name_max_len name
+  _ <- matches         Name name_format  name
   in pure name
 
 validate_ttl :: String -> V Errors Int
 validate_ttl str_ttl = ado
   ttl <- validate_integer TTL str_ttl
-  _   <- between TTL min_ttl max_ttl ttl
-  pure ttl
+  in ado
+    value  <- intBetween TTL min_ttl max_ttl ttl
+    in pure value
+
+validate_target :: String -> V Errors String
+validate_target target = ado
+  target <- lengthIsBetween Target target_min_len target_max_len target
+  in pure target
 
 -- Resource-related validations.
 
@@ -74,13 +91,17 @@ validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
 validateA form = ado
   name <- validate_name form.name
   ttl  <- validate_ttl form.ttl
-  -- TODO: validate target
+  target <- validate_target form.target
   in pure $ toRR_basic form.readonly form.rrid "A" name ttl target
 
 validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
 validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"]
 validateTXT :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
 validateTXT _ = invalid [Tuple NotAnAttribute "validation not implemented"]
+validateCNAME :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
+validateCNAME _ = invalid [Tuple NotAnAttribute "validation not implemented"]
+validateNS :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
+validateNS _ = invalid [Tuple NotAnAttribute "validation not implemented"]
 validateMX :: forall l. MXRR (|l) -> V Errors ResourceRecord
 validateMX _ = invalid [Tuple NotAnAttribute "validation not implemented"]
 validateSRV :: forall l. SRVRR (|l) -> V Errors ResourceRecord
@@ -137,11 +158,11 @@ toRR :: Int -> Boolean -> String -> String -> Int -> String
      -> RRMinttl
      -> ResourceRecord
 toRR rrid readonly rrtype rrname ttl target
-     priority priority port protocol weight mname rname serial refresh retry expire minttl
+     priority port protocol weight mname rname serial refresh retry expire minttl
   = { rrid:         rrid
     , readonly:     readonly
     , rrtype:       rrtype
-    , name:         name
+    , name:         rrname
     , ttl:          ttl
     , target:       target