{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
module Configuration.Utils.Validation
( ConfigValidation
, validateHttpOrHttpsUrl
, validateHttpUrl
, validateHttpsUrl
, validateUri
, validateAbsoluteUri
, validateAbsoluteUriFragment
, validateIPv4
, validateIPv6
, validatePort
, validateNonEmpty
, validateLength
, validateMinLength
, validateMaxLength
, validateMinMaxLength
, validateFilePath
, validateFile
, validateFileReadable
, validateFileWritable
, validateExecutable
, validateDirectory
, validateConfigFile
, validateFalse
, validateTrue
, validateBool
, validateNonNegative
, validatePositive
, validateNonPositive
, validateNegative
, validateNonNull
, validateLess
, validateLessEq
, validateGreater
, validateGreaterEq
, validateRange
) where
import Configuration.Utils.Internal
import Control.Monad.Error.Class
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Writer.Class
import qualified Data.Foldable as F
import Data.Monoid.Unicode
import qualified Data.Text as T
import Network.URI
import Prelude.Unicode
import System.Directory
type ConfigValidation a f = ∀ m . (MonadIO m, Functor m, Applicative m, MonadError T.Text m, MonadWriter (f T.Text) m) ⇒ a → m ()
validateHttpOrHttpsUrl
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateHttpOrHttpsUrl :: Text -> String -> m ()
validateHttpOrHttpsUrl Text
configName String
uri =
case String -> Maybe URI
parseURI String
uri of
Maybe URI
Nothing → Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
Just URI
u → Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (URI -> String
uriScheme URI
u String -> String -> Bool
forall α. Eq α => α -> α -> Bool
≡ String
"http:" Bool -> Bool -> Bool
|| URI -> String
uriScheme URI
u String -> String -> Bool
forall α. Eq α => α -> α -> Bool
≡ String
"https:") (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not an HTTP or HTTPS URL"
validateHttpUrl
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateHttpUrl :: Text -> String -> m ()
validateHttpUrl Text
configName String
uri =
case String -> Maybe URI
parseURI String
uri of
Maybe URI
Nothing → Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
Just URI
u → Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (URI -> String
uriScheme URI
u String -> String -> Bool
forall α. Eq α => α -> α -> Bool
≡ String
"http:") (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not an HTTP URL"
validateHttpsUrl
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateHttpsUrl :: Text -> String -> m ()
validateHttpsUrl Text
configName String
uri =
case String -> Maybe URI
parseURI String
uri of
Maybe URI
Nothing → Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
Just URI
u → Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (URI -> String
uriScheme URI
u String -> String -> Bool
forall α. Eq α => α -> α -> Bool
≡ String
"https:") (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not an HTTPS URL"
validateUri
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateUri :: Text -> String -> m ()
validateUri Text
configName String
uri =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isURIReference String
uri) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"The value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
validateAbsoluteUri
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateAbsoluteUri :: Text -> String -> m ()
validateAbsoluteUri Text
configName String
uri =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isAbsoluteURI String
uri) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"The value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
validateAbsoluteUriFragment
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateAbsoluteUriFragment :: Text -> String -> m ()
validateAbsoluteUriFragment Text
configName String
uri =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isURI String
uri) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"The value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
validateIPv4
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateIPv4 :: Text -> String -> m ()
validateIPv4 Text
configName String
ipv4 =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isIPv4address String
ipv4) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"The value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
ipv4 Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid IPv4 address"
validateIPv6
∷ MonadError T.Text m
⇒ T.Text
→ String
→ m ()
validateIPv6 :: Text -> String -> m ()
validateIPv6 Text
configName String
ipv6 =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isIPv6address String
ipv6) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"The value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
ipv6 Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid IPv6 address"
validatePort
∷ (MonadError T.Text m, Integral n, Show n)
⇒ T.Text
→ n
→ m ()
validatePort :: Text -> n -> m ()
validatePort Text
configName n
p =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (n
p n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
1 Bool -> Bool -> Bool
&& n
p n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
65535) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"port value " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack (n -> String
forall a. Show a => a -> String
show n
p) Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not valid port number"
validateNonEmpty
∷ (MonadError T.Text m, Eq a, Monoid a)
⇒ T.Text
→ a
→ m ()
validateNonEmpty :: Text -> a -> m ()
validateNonEmpty Text
configName a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x a -> a -> Bool
forall α. Eq α => α -> α -> Bool
≡ a
forall a. Monoid a => a
mempty) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must not be empty"
validateLength
∷ (MonadError T.Text m, F.Foldable f)
⇒ T.Text
→ Int
→ f a
→ m ()
validateLength :: Text -> Int -> f a -> m ()
validateLength Text
configName Int
len f a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x) Int -> Int -> Bool
forall α. Eq α => α -> α -> Bool
≡ Int
len) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be of length exactly " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Int -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Int
len
validateMaxLength
∷ (MonadError T.Text m, F.Foldable f)
⇒ T.Text
→ Int
→ f a
→ m ()
validateMaxLength :: Text -> Int -> f a -> m ()
validateMaxLength Text
configName Int
u f a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
≤ Int
u) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be of length at most " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Int -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Int
u
validateMinLength
∷ (MonadError T.Text m, F.Foldable f)
⇒ T.Text
→ Int
→ f a
→ m ()
validateMinLength :: Text -> Int -> f a -> m ()
validateMinLength Text
configName Int
l f a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
≥ Int
l) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be of length at least " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Int -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Int
l
validateMinMaxLength
∷ (MonadError T.Text m, F.Foldable f)
⇒ T.Text
→ Int
→ Int
→ f a
→ m ()
validateMinMaxLength :: Text -> Int -> Int -> f a -> m ()
validateMinMaxLength Text
configName Int
l Int
u f a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
≥ Int
l Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
≤ Int
u) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the length of the value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕
Text
" must be at least " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Int -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Int
l Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" and at most " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Int -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Int
u
where
len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x
validateFilePath
∷ MonadError T.Text m
⇒ T.Text
→ FilePath
→ m ()
validateFilePath :: Text -> String -> m ()
validateFilePath Text
configName String
file =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
file) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"file path for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must not be empty"
validateFile
∷ (MonadError T.Text m, MonadIO m)
⇒ T.Text
→ FilePath
→ m ()
validateFile :: Text -> String -> m ()
validateFile Text
configName String
file = do
Bool
exists ← IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
file
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the file " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" does not exist"
validateFileReadable
∷ (MonadError T.Text m, MonadIO m)
⇒ T.Text
→ FilePath
→ m ()
validateFileReadable :: Text -> String -> m ()
validateFileReadable Text
configName String
file = do
Text -> String -> m ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file
IO Permissions -> m Permissions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Permissions
getPermissions String
file) m Permissions -> (Permissions -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
x → Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
readable Permissions
x) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the file " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not readable"
validateFileWritable
∷ (MonadError T.Text m, MonadIO m)
⇒ T.Text
→ FilePath
→ m ()
validateFileWritable :: Text -> String -> m ()
validateFileWritable Text
configName String
file = do
Text -> String -> m ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file
IO Permissions -> m Permissions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Permissions
getPermissions String
file) m Permissions -> (Permissions -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
x → Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
writable Permissions
x) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the file " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not writable"
validateFileExecutable
∷ (MonadError T.Text m, MonadIO m)
⇒ T.Text
→ FilePath
→ m ()
validateFileExecutable :: Text -> String -> m ()
validateFileExecutable Text
configName String
file = do
Text -> String -> m ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file
IO Permissions -> m Permissions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Permissions
getPermissions String
file) m Permissions -> (Permissions -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
x → Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
executable Permissions
x) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the file " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" is not excutable"
validateDirectory
∷ (MonadError T.Text m, MonadIO m)
⇒ T.Text
→ FilePath
→ m ()
validateDirectory :: Text -> String -> m ()
validateDirectory Text
configName String
dir = do
Bool
exists ← IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
dir
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"the directory " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
dir Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" does not exist"
validateExecutable
∷ (Functor m, MonadError T.Text m, MonadIO m)
⇒ T.Text
→ FilePath
→ m ()
validateExecutable :: Text -> String -> m ()
validateExecutable Text
configName String
file = do
String
execFile ← (String
file String -> m () -> m String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> String -> m ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file) m String -> (Text -> m String) -> m String
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \Text
_ ->
IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
findExecutable String
file) m (Maybe String) -> (Maybe String -> m String) -> m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe String
Nothing → Text -> m String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m String) -> Text -> m String
forall a b. (a -> b) -> a -> b
$
Text
"the executable " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" could not be found in the system;"
Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" you may check your SearchPath and PATH variable settings"
Just String
f → String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
f
Text -> String -> m ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileExecutable Text
configName String
execFile
validateConfigFile
∷ (MonadIO m, MonadError T.Text m)
⇒ String
→ m ()
validateConfigFile :: String -> m ()
validateConfigFile String
filepath =
Text -> String -> m ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileReadable Text
"config-file" String
filepath
#ifdef REMOTE_CONFIGS
`catchError` \_ ->
validateHttpOrHttpsUrl "config-file" filepath
#endif
validateFalse
∷ (MonadError T.Text m)
⇒ T.Text
→ Bool
→ m ()
validateFalse :: Text -> Bool -> m ()
validateFalse Text
configName = Text -> Bool -> Bool -> m ()
forall (m :: * -> *).
MonadError Text m =>
Text -> Bool -> Bool -> m ()
validateBool Text
configName Bool
False
validateTrue
∷ (MonadError T.Text m)
⇒ T.Text
→ Bool
→ m ()
validateTrue :: Text -> Bool -> m ()
validateTrue Text
configName = Text -> Bool -> Bool -> m ()
forall (m :: * -> *).
MonadError Text m =>
Text -> Bool -> Bool -> m ()
validateBool Text
configName Bool
True
validateBool
∷ (MonadError T.Text m)
⇒ T.Text
→ Bool
→ Bool
→ m ()
validateBool :: Text -> Bool -> Bool -> m ()
validateBool Text
configName Bool
expected Bool
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
x Bool -> Bool -> Bool
forall α. Eq α => α -> α -> Bool
≡ Bool
expected) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"expected " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" to be " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Bool -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Bool
expected Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
", but was " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Bool -> Text
forall a s. (Show a, IsString s) => a -> s
sshow Bool
x
validateNonNegative
∷ (MonadError T.Text m, Ord a, Num a)
⇒ T.Text
→ a
→ m ()
validateNonNegative :: Text -> a -> m ()
validateNonNegative Text
configName a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must not be negative"
validatePositive
∷ (MonadError T.Text m, Ord a, Num a)
⇒ T.Text
→ a
→ m ()
validatePositive :: Text -> a -> m ()
validatePositive Text
configName a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
≤ a
0) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be positive"
validateNonPositive
∷ (MonadError T.Text m, Ord a, Num a)
⇒ T.Text
→ a
→ m ()
validateNonPositive :: Text -> a -> m ()
validateNonPositive Text
configName a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must not be positive"
validateNegative
∷ (MonadError T.Text m, Ord a, Num a)
⇒ T.Text
→ a
→ m ()
validateNegative :: Text -> a -> m ()
validateNegative Text
configName a
x =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
≥ a
0) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be negative"
validateNonNull
∷ (MonadError T.Text m, Eq a, Num a)
⇒ T.Text
→ a
→ m ()
validateNonNull :: Text -> a -> m ()
validateNonNull Text
configName a
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x a -> a -> Bool
forall α. Eq α => α -> α -> Bool
≡ a
0) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must not be zero"
validateLess
∷ (MonadError T.Text m, Ord a, Show a)
⇒ T.Text
→ a
→ a
→ m ()
validateLess :: Text -> a -> a -> m ()
validateLess Text
configName a
upper a
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
upper) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be strictly less than " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
upper Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
", but was " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
x
validateLessEq
∷ (MonadError T.Text m, Ord a, Show a)
⇒ T.Text
→ a
→ a
→ m ()
validateLessEq :: Text -> a -> a -> m ()
validateLessEq Text
configName a
upper a
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
≤ a
upper) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be less or equal than " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
upper Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
", but was " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
x
validateGreater
∷ (MonadError T.Text m, Ord a, Show a)
⇒ T.Text
→ a
→ a
→ m ()
validateGreater :: Text -> a -> a -> m ()
validateGreater Text
configName a
lower a
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
lower) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be strictly greater than " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
lower Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
", but was " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
x
validateGreaterEq
∷ (MonadError T.Text m, Ord a, Show a)
⇒ T.Text
→ a
→ a
→ m ()
validateGreaterEq :: Text -> a -> a -> m ()
validateGreaterEq Text
configName a
lower a
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
≥ a
lower) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be greater or equal than " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
lower Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
", but was " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
x
validateRange
∷ (MonadError T.Text m, Ord a, Show a)
⇒ T.Text
→ (a, a)
→ a
→ m ()
validateRange :: Text -> (a, a) -> a -> m ()
validateRange Text
configName (a
lower,a
upper) a
x = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
≥ a
lower Bool -> Bool -> Bool
∧ a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
≤ a
upper) (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"value for " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
configName Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
" must be within the range of (" Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
lower Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
", " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
upper Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
"), but was " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ a -> Text
forall a s. (Show a, IsString s) => a -> s
sshow a
x