{-# 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 :: 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"

-- | 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 :: 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"

-- | 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 :: 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"

-- | 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 :: 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"

-- | 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 :: 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"

-- | 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 :: 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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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"

-- -------------------------------------------------------------------------- --
-- 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 :: 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
        -- ^ configuration property name that is used in the error message
     Int
        -- ^ exact length of the validated value
     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
        -- ^ configuration property name that is used in the error message
     Int
        -- ^ maximum length of the validated value
     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
        -- ^ configuration property name that is used in the error message
     Int
        -- ^ minimum length of the validated value
     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
        -- ^ 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 :: 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

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

validateFilePath
     MonadError T.Text m
     T.Text
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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"

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

-- | Validate that the input is a config file
--
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

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

validateFalse
     (MonadError T.Text m)
     T.Text
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     Bool
        -- ^ expected value
     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

-- -------------------------------------------------------------------------- --
-- 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 :: 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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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
        -- ^ configuration property name that is used in the error message
     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"

-- -------------------------------------------------------------------------- --
-- 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 :: 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
        -- ^ configuration property name that is used in the error message
     a
        -- ^ a upper bound for the configuration value
     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
        -- ^ configuration property name that is used in the error message
     a
        -- ^ a strict lower bound for the configuration value
     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
        -- ^ configuration property name that is used in the error message
     a
        -- ^ a lower bound for the configuration value
     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
        -- ^ configuration property name that is used in the error message
     (a, a)
        -- ^ the valid range for the configuration value
     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