module Serokell.Util.Verify
( VerificationRes (..)
, isVerFailure
, isVerSuccess
, verResToMonadError
, verifyGeneric
, buildVerResFull
, buildVerResSingle
, formatAllErrors
, formatFirstError
, verResFullF
, verResSingleF
) where
import Control.Monad.Except (MonadError, throwError)
import Data.Semigroup (Semigroup)
import qualified Data.Semigroup as Semigroup
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B
import Formatting (Format, later, sformat)
import Serokell.Util.Text (listBuilder)
data VerificationRes
= VerSuccess
| VerFailure ![T.Text]
deriving (Eq, Show)
isVerSuccess :: VerificationRes -> Bool
isVerSuccess VerSuccess = True
isVerSuccess _ = False
isVerFailure :: VerificationRes -> Bool
isVerFailure (VerFailure _) = True
isVerFailure _ = False
instance Semigroup VerificationRes where
VerSuccess <> a = a
VerFailure xs <> a =
VerFailure $
xs ++
case a of
VerSuccess -> []
VerFailure ys -> ys
instance Monoid VerificationRes where
mempty = VerSuccess
mappend = (Semigroup.<>)
verifyGeneric :: [(Bool, T.Text)] -> VerificationRes
verifyGeneric errors
| null messages = VerSuccess
| otherwise = VerFailure messages
where
messages = map snd . filter (not . fst) $ errors
buildVerResFull :: VerificationRes -> B.Builder
buildVerResFull VerSuccess = buildVerResImpl Nothing
buildVerResFull (VerFailure errors) = buildVerResImpl $ Just errors
buildVerResSingle :: VerificationRes -> B.Builder
buildVerResSingle VerSuccess = buildVerResImpl Nothing
buildVerResSingle (VerFailure errors) = buildVerResImpl $ Just $ [head errors]
buildVerResImpl :: Maybe [T.Text] -> B.Builder
buildVerResImpl Nothing = "success"
buildVerResImpl (Just errors) =
"failure: " `mappend` listBuilder @Text @Text @Text "[" "; " "]" errors
verResFullF :: Format r (VerificationRes -> r)
verResFullF = later buildVerResFull
verResSingleF :: Format r (VerificationRes -> r)
verResSingleF = later buildVerResSingle
formatAllErrors :: [Text] -> Text
formatAllErrors = sformat verResFullF . VerFailure
formatFirstError :: [Text] -> Text
formatFirstError = sformat verResSingleF . VerFailure
verResToMonadError
:: MonadError e m
=> ([Text] -> e) -> VerificationRes -> m ()
verResToMonadError _ VerSuccess = pure ()
verResToMonadError f (VerFailure errors) = throwError $ f errors