{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}

-- |
-- Module: Configuration.Utils.Validation
-- Copyright: Copyright © 2014 AlephCloud Systems, Inc.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@alephcloud.com>
-- Stability: experimental
--
-- Utilities for validating configuration values
--
module Configuration.Utils.Validation
( ConfigValidation

-- * Networking
, validateHttpOrHttpsUrl
, validateHttpUrl
, validateHttpsUrl
, validateUri
, validateAbsoluteUri
, validateAbsoluteUriFragment
, validateIPv4
, validateIPv6
, validatePort

-- * Monoids, Foldables and Co
, validateNonEmpty
, validateLength
, validateMinLength
, validateMaxLength
, validateMinMaxLength

-- * Files
, validateFilePath
, validateFile
, validateFileReadable
, validateFileWritable
, validateExecutable
, validateDirectory
, validateConfigFile

-- * Boolean Values
, validateFalse
, validateTrue
, validateBool

-- * Numeric Values
, validateNonNegative
, validatePositive
, validateNonPositive
, validateNegative
, validateNonNull

-- * Orders
, 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

-- | A validation function. The type in the 'MonadWriter' is excpected to
-- be a 'Foldable' structure for collecting warnings.
--
type ConfigValidation a f = ∀ m . (MonadIO m, Functor m, Applicative m, MonadError T.Text m, MonadWriter (f T.Text) m) ⇒ a → m ()

-- -------------------------------------------------------------------------- --
-- Networking

-- | Validates that a value is an HTTP or HTTPS URL
--
validateHttpOrHttpsUrl
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateHttpOrHttpsUrl :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateHttpOrHttpsUrl Text
configName String
uri =
    case String -> Maybe URI
parseURI String
uri of
        Maybe URI
Nothing → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Text
"the value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
        Just URI
u → forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (URI -> String
uriScheme URI
u forall α. Eq α => α -> α -> Bool
≡ String
"http:" Bool -> Bool -> Bool
|| URI -> String
uriScheme URI
u forall α. Eq α => α -> α -> Bool
≡ String
"https:") forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Text
"the value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not an HTTP or HTTPS URL"

-- | Validates that a value is an HTTP URL
--
validateHttpUrl
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateHttpUrl :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateHttpUrl Text
configName String
uri =
    case String -> Maybe URI
parseURI String
uri of
        Maybe URI
Nothing → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Text
"the value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
        Just URI
u → forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (URI -> String
uriScheme URI
u forall α. Eq α => α -> α -> Bool
≡ String
"http:") forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Text
"the value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not an HTTP URL"

-- | Validates that a value is an HTTPS URL
--
validateHttpsUrl
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateHttpsUrl :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateHttpsUrl Text
configName String
uri =
    case String -> Maybe URI
parseURI String
uri of
        Maybe URI
Nothing → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Text
"the value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"
        Just URI
u → forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (URI -> String
uriScheme URI
u forall α. Eq α => α -> α -> Bool
≡ String
"https:") forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Text
"the value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not an HTTPS URL"

-- | Validates that a value is an URI without a fragment identifier
--
validateUri
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateUri :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateUri Text
configName String
uri =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isURIReference String
uri) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"The value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"

-- | Validates that a value is an absolute URI without a fragment identifier
--
validateAbsoluteUri
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateAbsoluteUri :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateAbsoluteUri Text
configName String
uri =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isAbsoluteURI String
uri) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"The value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"

-- | Validates that a value is an absolute URI with an optional fragment
-- identifier
--
validateAbsoluteUriFragment
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateAbsoluteUriFragment :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateAbsoluteUriFragment Text
configName String
uri =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isURI String
uri) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"The value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
uri forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid URI"

validateIPv4
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateIPv4 :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateIPv4 Text
configName String
ipv4 =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isIPv4address String
ipv4) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"The value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
ipv4 forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid IPv4 address"

validateIPv6
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → String
    → m ()
validateIPv6 :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateIPv6 Text
configName String
ipv6 =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isIPv6address String
ipv6) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"The value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
ipv6 forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not a valid IPv6 address"

validatePort
    ∷ (MonadError T.Text m, Integral n, Show n)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → n
    → m ()
validatePort :: forall (m :: * -> *) n.
(MonadError Text m, Integral n, Show n) =>
Text -> n -> m ()
validatePort Text
configName n
p =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (n
p forall a. Ord a => a -> a -> Bool
> n
1 Bool -> Bool -> Bool
&& n
p forall a. Ord a => a -> a -> Bool
< n
65535) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"port value " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack (forall a. Show a => a -> String
show n
p) forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not valid port number"

-- -------------------------------------------------------------------------- --
-- Monoids, Foldables, and Co

validateNonEmpty
    ∷ (MonadError T.Text m, Eq a, Monoid a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
    → m ()
validateNonEmpty :: forall (m :: * -> *) a.
(MonadError Text m, Eq a, Monoid a) =>
Text -> a -> m ()
validateNonEmpty Text
configName a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x forall α. Eq α => α -> α -> Bool
≡ forall a. Monoid a => a
mempty) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must not be empty"

validateLength
    ∷ (MonadError T.Text m, F.Foldable f)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Int
        -- ^ exact length of the validated value
    → f a
    → m ()
validateLength :: forall (m :: * -> *) (f :: * -> *) a.
(MonadError Text m, Foldable f) =>
Text -> Int -> f a -> m ()
validateLength Text
configName Int
len f a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x) forall α. Eq α => α -> α -> Bool
≡ Int
len) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be of length exactly " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Int
len

validateMaxLength
    ∷ (MonadError T.Text m, F.Foldable f)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Int
        -- ^ maximum length of the validated value
    → f a
    → m ()
validateMaxLength :: forall (m :: * -> *) (f :: * -> *) a.
(MonadError Text m, Foldable f) =>
Text -> Int -> f a -> m ()
validateMaxLength Text
configName Int
u f a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x) forall a. Ord a => a -> a -> Bool
≤ Int
u) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be of length at most " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Int
u

validateMinLength
    ∷ (MonadError T.Text m, F.Foldable f)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Int
        -- ^ minimum length of the validated value
    → f a
    → m ()
validateMinLength :: forall (m :: * -> *) (f :: * -> *) a.
(MonadError Text m, Foldable f) =>
Text -> Int -> f a -> m ()
validateMinLength Text
configName Int
l f a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x) forall a. Ord a => a -> a -> Bool
≥ Int
l) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be of length at least " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Int
l

validateMinMaxLength
    ∷ (MonadError T.Text m, F.Foldable f)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Int
        -- ^ minimum length of the validated value
    → Int
        -- ^ maximum length of the validated value
    → f a
    → m ()
validateMinMaxLength :: forall (m :: * -> *) (f :: * -> *) a.
(MonadError Text m, Foldable f) =>
Text -> Int -> Int -> f a -> m ()
validateMinMaxLength Text
configName Int
l Int
u f a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
len forall a. Ord a => a -> a -> Bool
≥ Int
l Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
≤ Int
u) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"the length of the value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕
        Text
" must be at least " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Int
l forall α. Monoid α => α -> α -> α
⊕ Text
" and at most " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Int
u
  where
    len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
x

-- -------------------------------------------------------------------------- --
-- Files

validateFilePath
    ∷ MonadError T.Text m
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateFilePath :: forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateFilePath Text
configName String
file =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
file) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"file path for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must not be empty"

validateFile
    ∷ (MonadError T.Text m, MonadIO m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateFile :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file = do
    Bool
exists ← forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
file
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"the file " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" does not exist"

validateFileReadable
    ∷ (MonadError T.Text m, MonadIO m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateFileReadable :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileReadable Text
configName String
file = do
    forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Permissions
getPermissions String
file) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
x → forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
readable Permissions
x) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"the file " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not readable"

validateFileWritable
    ∷ (MonadError T.Text m, MonadIO m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateFileWritable :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileWritable Text
configName String
file = do
    forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Permissions
getPermissions String
file) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
x → forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
writable Permissions
x) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"the file " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not writable"

validateFileExecutable
    ∷ (MonadError T.Text m, MonadIO m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateFileExecutable :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileExecutable Text
configName String
file = do
    forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Permissions
getPermissions String
file) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Permissions
x → forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
executable Permissions
x) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"the file " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" is not excutable"

validateDirectory
    ∷ (MonadError T.Text m, MonadIO m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateDirectory :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateDirectory Text
configName String
dir = do
    Bool
exists ← forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"the directory " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
dir forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" does not exist"

-- | Validates if the given executable name can be found in the system
-- and can be executed.
--
validateExecutable
    ∷ (Functor m, MonadError T.Text m, MonadIO m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → FilePath
    → m ()
validateExecutable :: forall (m :: * -> *).
(Functor m, MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateExecutable Text
configName String
file = do
    String
execFile ← (String
file forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFile Text
configName String
file) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \Text
_ ->
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
findExecutable String
file) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe String
Nothing → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
                Text
"the executable " forall α. Monoid α => α -> α -> α
⊕ String -> Text
T.pack String
file forall α. Monoid α => α -> α -> α
⊕ Text
" for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" could not be found in the system;"
                forall α. Monoid α => α -> α -> α
⊕ Text
" you may check your SearchPath and PATH variable settings"
            Just String
f → forall (m :: * -> *) a. Monad m => a -> m a
return String
f
    forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileExecutable Text
configName String
execFile

-- | Validate that the input is a config file
--
validateConfigFile
    ∷ (MonadIO m, MonadError T.Text m)
    ⇒ String
    → m ()
validateConfigFile :: forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
String -> m ()
validateConfigFile String
filepath =
    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

-- -------------------------------------------------------------------------- --
-- Boolean Values

validateFalse
    ∷ (MonadError T.Text m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Bool
    → m ()
validateFalse :: forall (m :: * -> *). MonadError Text m => Text -> Bool -> m ()
validateFalse Text
configName = forall (m :: * -> *).
MonadError Text m =>
Text -> Bool -> Bool -> m ()
validateBool Text
configName Bool
False

validateTrue
    ∷ (MonadError T.Text m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Bool
    → m ()
validateTrue :: forall (m :: * -> *). MonadError Text m => Text -> Bool -> m ()
validateTrue Text
configName = forall (m :: * -> *).
MonadError Text m =>
Text -> Bool -> Bool -> m ()
validateBool Text
configName Bool
True

validateBool
    ∷ (MonadError T.Text m)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → Bool
        -- ^ expected value
    → Bool
    → m ()
validateBool :: forall (m :: * -> *).
MonadError Text m =>
Text -> Bool -> Bool -> m ()
validateBool Text
configName Bool
expected Bool
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
x forall α. Eq α => α -> α -> Bool
≡ Bool
expected) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"expected " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" to be " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Bool
expected forall α. Monoid α => α -> α -> α
⊕ Text
", but was " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow Bool
x

-- -------------------------------------------------------------------------- --
-- Numeric Values

validateNonNegative
    ∷ (MonadError T.Text m, Ord a, Num a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
    → m ()
validateNonNegative :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Num a) =>
Text -> a -> m ()
validateNonNegative Text
configName a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x forall a. Ord a => a -> a -> Bool
< a
0) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must not be negative"

validatePositive
    ∷ (MonadError T.Text m, Ord a, Num a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
    → m ()
validatePositive :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Num a) =>
Text -> a -> m ()
validatePositive Text
configName a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x forall a. Ord a => a -> a -> Bool
≤ a
0) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be positive"

validateNonPositive
    ∷ (MonadError T.Text m, Ord a, Num a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
    → m ()
validateNonPositive :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Num a) =>
Text -> a -> m ()
validateNonPositive Text
configName a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x forall a. Ord a => a -> a -> Bool
> a
0) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must not be positive"

validateNegative
    ∷ (MonadError T.Text m, Ord a, Num a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
    → m ()
validateNegative :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Num a) =>
Text -> a -> m ()
validateNegative Text
configName a
x =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x forall a. Ord a => a -> a -> Bool
≥ a
0) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
        Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be negative"

validateNonNull
    ∷ (MonadError T.Text m, Eq a, Num a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
    → m ()
validateNonNull :: forall (m :: * -> *) a.
(MonadError Text m, Eq a, Num a) =>
Text -> a -> m ()
validateNonNull Text
configName a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
x forall α. Eq α => α -> α -> Bool
≡ a
0) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must not be zero"

-- -------------------------------------------------------------------------- --
-- Orders

validateLess
    ∷ (MonadError T.Text m, Ord a, Show a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
        -- ^ a strict upper bound for the configuration value
    → a
    → m ()
validateLess :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Show a) =>
Text -> a -> a -> m ()
validateLess Text
configName a
upper a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x forall a. Ord a => a -> a -> Bool
< a
upper) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be strictly less than " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
upper forall α. Monoid α => α -> α -> α
⊕ Text
", but was " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
x

validateLessEq
    ∷ (MonadError T.Text m, Ord a, Show a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
        -- ^ a upper bound for the configuration value
    → a
    → m ()
validateLessEq :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Show a) =>
Text -> a -> a -> m ()
validateLessEq Text
configName a
upper a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x forall a. Ord a => a -> a -> Bool
≤ a
upper) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be less or equal than " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
upper forall α. Monoid α => α -> α -> α
⊕ Text
", but was " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
x

validateGreater
    ∷ (MonadError T.Text m, Ord a, Show a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
        -- ^ a strict lower bound for the configuration value
    → a
    → m ()
validateGreater :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Show a) =>
Text -> a -> a -> m ()
validateGreater Text
configName a
lower a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x forall a. Ord a => a -> a -> Bool
> a
lower) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be strictly greater than " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
lower forall α. Monoid α => α -> α -> α
⊕ Text
", but was " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
x

validateGreaterEq
    ∷ (MonadError T.Text m, Ord a, Show a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → a
        -- ^ a lower bound for the configuration value
    → a
    → m ()
validateGreaterEq :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Show a) =>
Text -> a -> a -> m ()
validateGreaterEq Text
configName a
lower a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x forall a. Ord a => a -> a -> Bool
≥ a
lower) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be greater or equal than " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
lower forall α. Monoid α => α -> α -> α
⊕ Text
", but was " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
x

validateRange
    ∷ (MonadError T.Text m, Ord a, Show a)
    ⇒ T.Text
        -- ^ configuration property name that is used in the error message
    → (a, a)
        -- ^ the valid range for the configuration value
    → a
    → m ()
validateRange :: forall (m :: * -> *) a.
(MonadError Text m, Ord a, Show a) =>
Text -> (a, a) -> a -> m ()
validateRange Text
configName (a
lower,a
upper) a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
x forall a. Ord a => a -> a -> Bool
≥ a
lower Bool -> Bool -> Bool
∧ a
x forall a. Ord a => a -> a -> Bool
≤ a
upper) forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
    Text
"value for " forall α. Monoid α => α -> α -> α
⊕ Text
configName forall α. Monoid α => α -> α -> α
⊕ Text
" must be within the range of (" forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
lower forall α. Monoid α => α -> α -> α
⊕ Text
", " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
upper forall α. Monoid α => α -> α -> α
⊕ Text
"), but was " forall α. Monoid α => α -> α -> α
⊕ forall a s. (Show a, IsString s) => a -> s
sshow a
x