{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# OPTIONS_GHC -fno-warn-unused-imports#-}

module Data.KeyStore.KS.Opt
    ( Opt
    , OptEnum(..)
    , opt_enum
    , getSettingsOpt
    , getSettingsOpt'
    , setSettingsOpt
    , opt__debug_enabled
    , opt__verify_enabled
    , opt__sections_fix
    , opt__backup_keys
    , opt__hash_comment
    , opt__hash_prf
    , opt__hash_iterations
    , opt__hash_width_octets
    , opt__hash_salt_octets
    , opt__crypt_cipher
    , opt__crypt_prf
    , opt__crypt_iterations
    , opt__crypt_salt_octets
    , Opt_(..)
    , opt_
    , listSettingsOpts
    , optHelp
    , optName
    , parseOpt
    ) where

import           Data.KeyStore.Types
import qualified Data.Vector                    as V
import qualified Data.Map                       as Map
import qualified Data.ByteString.Lazy.Char8     as LBS
import qualified Data.HashMap.Strict            as HM
import           Data.Aeson
import qualified Data.Text                      as T
import           Data.Monoid
import           Data.Maybe
import           Data.Char
import           Text.Printf


data Opt a
    = Opt
        { forall a. Opt a -> OptEnum
opt_enum    :: OptEnum
        , forall a. Opt a -> a
opt_default :: a
        , forall a. Opt a -> Value -> a
opt_from    :: Value -> a
        , forall a. Opt a -> a -> Value
opt_to      :: a -> Value
        , forall a. Opt a -> Help
opt_help    :: Help
        }

data Help
    = Help
        { Help -> [Text]
hlp_text :: [T.Text]
        , Help -> Text
hlp_type :: T.Text
        }
    deriving Int -> Help -> ShowS
[Help] -> ShowS
Help -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Help] -> ShowS
$cshowList :: [Help] -> ShowS
show :: Help -> [Char]
$cshow :: Help -> [Char]
showsPrec :: Int -> Help -> ShowS
$cshowsPrec :: Int -> Help -> ShowS
Show

getSettingsOpt :: Opt a -> Settings -> a
getSettingsOpt :: forall a. Opt a -> Settings -> a
getSettingsOpt Opt a
opt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Opt a -> a
opt_default Opt a
opt) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Opt a -> Settings -> Maybe a
getSettingsOpt' Opt a
opt

getSettingsOpt' :: Opt a -> Settings -> Maybe a
getSettingsOpt' :: forall a. Opt a -> Settings -> Maybe a
getSettingsOpt' Opt{a
OptEnum
Help
a -> Value
Value -> a
opt_help :: Help
opt_to :: a -> Value
opt_from :: Value -> a
opt_default :: a
opt_enum :: OptEnum
opt_help :: forall a. Opt a -> Help
opt_to :: forall a. Opt a -> a -> Value
opt_from :: forall a. Opt a -> Value -> a
opt_default :: forall a. Opt a -> a
opt_enum :: forall a. Opt a -> OptEnum
..} (Settings HashMap Text Value
hm) = Value -> a
opt_from forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (OptEnum -> Text
optName OptEnum
opt_enum) HashMap Text Value
hm

setSettingsOpt :: Opt a -> a -> Settings -> Settings
setSettingsOpt :: forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt{a
OptEnum
Help
a -> Value
Value -> a
opt_help :: Help
opt_to :: a -> Value
opt_from :: Value -> a
opt_default :: a
opt_enum :: OptEnum
opt_help :: forall a. Opt a -> Help
opt_to :: forall a. Opt a -> a -> Value
opt_from :: forall a. Opt a -> Value -> a
opt_default :: forall a. Opt a -> a
opt_enum :: forall a. Opt a -> OptEnum
..} a
x (Settings HashMap Text Value
hm) =
                  HashMap Text Value -> Settings
Settings forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (OptEnum -> Text
optName OptEnum
opt_enum) (a -> Value
opt_to a
x) HashMap Text Value
hm


opt__debug_enabled        :: Opt Bool
opt__debug_enabled :: Opt Bool
opt__debug_enabled        = [Text] -> Bool -> OptEnum -> Opt Bool
bool_opt [Text]
dbg_help                            Bool
False       OptEnum
Debug__enabled

opt__verify_enabled       :: Opt Bool
opt__verify_enabled :: Opt Bool
opt__verify_enabled       = [Text] -> Bool -> OptEnum -> Opt Bool
bool_opt [Text]
vfy_help                            Bool
False       OptEnum
Verify__enabled

opt__sections_fix         :: Opt Bool
opt__sections_fix :: Opt Bool
opt__sections_fix         = [Text] -> Bool -> OptEnum -> Opt Bool
bool_opt [Text]
sfx_help                            Bool
False       OptEnum
Sections__fix

opt__backup_keys          :: Opt [Name]
opt__backup_keys :: Opt [Name]
opt__backup_keys          = [Text] -> OptEnum -> Opt [Name]
backup_opt [Text]
bku_help                                      OptEnum
Backup__keys

opt__hash_comment         :: Opt Comment
opt__hash_comment :: Opt Comment
opt__hash_comment         = forall a. [Text] -> (Text -> a, a -> Text) -> a -> OptEnum -> Opt a
text_opt [Text]
hcm_help (Text -> Comment
Comment   ,Comment -> Text
_Comment)      Comment
""          OptEnum
Hash__comment

opt__hash_prf             :: Opt HashPRF
opt__hash_prf :: Opt HashPRF
opt__hash_prf             = forall a.
(Bounded a, Enum a) =>
[Text] -> (a -> Text) -> a -> OptEnum -> Opt a
enum_opt [Text]
hpr_help  HashPRF -> Text
_text_HashPRF             HashPRF
PRF_sha512  OptEnum
Hash__prf

opt__hash_iterations      :: Opt Iterations
opt__hash_iterations :: Opt Iterations
opt__hash_iterations      = forall a. [Text] -> (Int -> a, a -> Int) -> a -> OptEnum -> Opt a
intg_opt [Text]
hit_help (Int -> Iterations
Iterations,Iterations -> Int
_Iterations)   Iterations
5000        OptEnum
Hash__iterations

opt__hash_width_octets    :: Opt Octets
opt__hash_width_octets :: Opt Octets
opt__hash_width_octets    = forall a. [Text] -> (Int -> a, a -> Int) -> a -> OptEnum -> Opt a
intg_opt [Text]
hwd_help (Int -> Octets
Octets    ,Octets -> Int
_Octets    )   Octets
64          OptEnum
Hash__width_octets

opt__hash_salt_octets     :: Opt Octets
opt__hash_salt_octets :: Opt Octets
opt__hash_salt_octets     = forall a. [Text] -> (Int -> a, a -> Int) -> a -> OptEnum -> Opt a
intg_opt [Text]
hna_help (Int -> Octets
Octets    ,Octets -> Int
_Octets    )   Octets
16          OptEnum
Hash__salt_octets

opt__crypt_cipher         :: Opt Cipher
opt__crypt_cipher :: Opt Cipher
opt__crypt_cipher         = forall a.
(Bounded a, Enum a) =>
[Text] -> (a -> Text) -> a -> OptEnum -> Opt a
enum_opt [Text]
ccy_help  Cipher -> Text
_text_Cipher              Cipher
CPH_aes256  OptEnum
Crypt__cipher

opt__crypt_prf            :: Opt HashPRF
opt__crypt_prf :: Opt HashPRF
opt__crypt_prf            = forall a.
(Bounded a, Enum a) =>
[Text] -> (a -> Text) -> a -> OptEnum -> Opt a
enum_opt [Text]
cpr_help  HashPRF -> Text
_text_HashPRF             HashPRF
PRF_sha512  OptEnum
Crypt__prf

opt__crypt_iterations     :: Opt Iterations
opt__crypt_iterations :: Opt Iterations
opt__crypt_iterations     = forall a. [Text] -> (Int -> a, a -> Int) -> a -> OptEnum -> Opt a
intg_opt [Text]
cit_help (Int -> Iterations
Iterations,Iterations -> Int
_Iterations)   Iterations
5000        OptEnum
Crypt__iterations

opt__crypt_salt_octets    :: Opt Octets
opt__crypt_salt_octets :: Opt Octets
opt__crypt_salt_octets    = forall a. [Text] -> (Int -> a, a -> Int) -> a -> OptEnum -> Opt a
intg_opt [Text]
cna_help (Int -> Octets
Octets    ,Octets -> Int
_Octets    )   Octets
16          OptEnum
Crypt__salt_octets


data OptEnum
    = Debug__enabled
    | Verify__enabled
    | Sections__fix
    | Backup__keys
    | Hash__comment
    | Hash__prf
    | Hash__iterations
    | Hash__width_octets
    | Hash__salt_octets
    | Crypt__cipher
    | Crypt__prf
    | Crypt__iterations
    | Crypt__salt_octets
    deriving (OptEnum
forall a. a -> a -> Bounded a
maxBound :: OptEnum
$cmaxBound :: OptEnum
minBound :: OptEnum
$cminBound :: OptEnum
Bounded,Int -> OptEnum
OptEnum -> Int
OptEnum -> [OptEnum]
OptEnum -> OptEnum
OptEnum -> OptEnum -> [OptEnum]
OptEnum -> OptEnum -> OptEnum -> [OptEnum]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OptEnum -> OptEnum -> OptEnum -> [OptEnum]
$cenumFromThenTo :: OptEnum -> OptEnum -> OptEnum -> [OptEnum]
enumFromTo :: OptEnum -> OptEnum -> [OptEnum]
$cenumFromTo :: OptEnum -> OptEnum -> [OptEnum]
enumFromThen :: OptEnum -> OptEnum -> [OptEnum]
$cenumFromThen :: OptEnum -> OptEnum -> [OptEnum]
enumFrom :: OptEnum -> [OptEnum]
$cenumFrom :: OptEnum -> [OptEnum]
fromEnum :: OptEnum -> Int
$cfromEnum :: OptEnum -> Int
toEnum :: Int -> OptEnum
$ctoEnum :: Int -> OptEnum
pred :: OptEnum -> OptEnum
$cpred :: OptEnum -> OptEnum
succ :: OptEnum -> OptEnum
$csucc :: OptEnum -> OptEnum
Enum,OptEnum -> OptEnum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptEnum -> OptEnum -> Bool
$c/= :: OptEnum -> OptEnum -> Bool
== :: OptEnum -> OptEnum -> Bool
$c== :: OptEnum -> OptEnum -> Bool
Eq,Eq OptEnum
OptEnum -> OptEnum -> Bool
OptEnum -> OptEnum -> Ordering
OptEnum -> OptEnum -> OptEnum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OptEnum -> OptEnum -> OptEnum
$cmin :: OptEnum -> OptEnum -> OptEnum
max :: OptEnum -> OptEnum -> OptEnum
$cmax :: OptEnum -> OptEnum -> OptEnum
>= :: OptEnum -> OptEnum -> Bool
$c>= :: OptEnum -> OptEnum -> Bool
> :: OptEnum -> OptEnum -> Bool
$c> :: OptEnum -> OptEnum -> Bool
<= :: OptEnum -> OptEnum -> Bool
$c<= :: OptEnum -> OptEnum -> Bool
< :: OptEnum -> OptEnum -> Bool
$c< :: OptEnum -> OptEnum -> Bool
compare :: OptEnum -> OptEnum -> Ordering
$ccompare :: OptEnum -> OptEnum -> Ordering
Ord,Int -> OptEnum -> ShowS
[OptEnum] -> ShowS
OptEnum -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OptEnum] -> ShowS
$cshowList :: [OptEnum] -> ShowS
show :: OptEnum -> [Char]
$cshow :: OptEnum -> [Char]
showsPrec :: Int -> OptEnum -> ShowS
$cshowsPrec :: Int -> OptEnum -> ShowS
Show)

data Opt_ = forall a. Opt_ (Opt a)

opt_ :: OptEnum -> Opt_
opt_ :: OptEnum -> Opt_
opt_ OptEnum
enm =
    case OptEnum
enm of
      OptEnum
Debug__enabled        -> forall a. Opt a -> Opt_
Opt_ Opt Bool
opt__debug_enabled
      OptEnum
Verify__enabled       -> forall a. Opt a -> Opt_
Opt_ Opt Bool
opt__verify_enabled
      OptEnum
Sections__fix         -> forall a. Opt a -> Opt_
Opt_ Opt Bool
opt__sections_fix
      OptEnum
Backup__keys          -> forall a. Opt a -> Opt_
Opt_ Opt [Name]
opt__backup_keys
      OptEnum
Hash__comment         -> forall a. Opt a -> Opt_
Opt_ Opt Comment
opt__hash_comment
      OptEnum
Hash__prf             -> forall a. Opt a -> Opt_
Opt_ Opt HashPRF
opt__hash_prf
      OptEnum
Hash__iterations      -> forall a. Opt a -> Opt_
Opt_ Opt Iterations
opt__hash_iterations
      OptEnum
Hash__width_octets    -> forall a. Opt a -> Opt_
Opt_ Opt Octets
opt__hash_width_octets
      OptEnum
Hash__salt_octets     -> forall a. Opt a -> Opt_
Opt_ Opt Octets
opt__hash_salt_octets
      OptEnum
Crypt__cipher         -> forall a. Opt a -> Opt_
Opt_ Opt Cipher
opt__crypt_cipher
      OptEnum
Crypt__prf            -> forall a. Opt a -> Opt_
Opt_ Opt HashPRF
opt__crypt_prf
      OptEnum
Crypt__iterations     -> forall a. Opt a -> Opt_
Opt_ Opt Iterations
opt__crypt_iterations
      OptEnum
Crypt__salt_octets    -> forall a. Opt a -> Opt_
Opt_ Opt Octets
opt__crypt_salt_octets


listSettingsOpts :: Maybe OptEnum -> T.Text
listSettingsOpts :: Maybe OptEnum -> Text
listSettingsOpts Maybe OptEnum
Nothing   = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map OptEnum -> Text
optName [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
listSettingsOpts (Just OptEnum
oe) = OptEnum -> Text
optHelp OptEnum
oe

optHelp :: OptEnum -> T.Text
optHelp :: OptEnum -> Text
optHelp = Opt_ -> Text
help forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptEnum -> Opt_
opt_

help :: Opt_ -> T.Text
help :: Opt_ -> Text
help (Opt_ Opt{a
OptEnum
Help
a -> Value
Value -> a
opt_help :: Help
opt_to :: a -> Value
opt_from :: Value -> a
opt_default :: a
opt_enum :: OptEnum
opt_help :: forall a. Opt a -> Help
opt_to :: forall a. Opt a -> a -> Value
opt_from :: forall a. Opt a -> Value -> a
opt_default :: forall a. Opt a -> a
opt_enum :: forall a. Opt a -> OptEnum
..}) = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
f
    [ (,) Text
pth           Text
""
    , (,) Text
"  type:"     Text
hlp_type
    , (,) Text
"  default:"  Text
dflt
    , (,) Text
""            Text
""
    ] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (Text
"  "forall a. Semigroup a => a -> a -> a
<>) [Text]
hlp_text
  where
    f :: (Text, Text) -> Text
f (Text
l,Text
v) = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%-12s %s" (Text -> [Char]
T.unpack Text
l) (Text -> [Char]
T.unpack Text
v)

    pth :: Text
pth     = OptEnum -> Text
optName OptEnum
opt_enum

    dflt :: Text
dflt    = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
LBS.unpack forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ a -> Value
opt_to a
opt_default

    Help{[Text]
Text
hlp_text :: [Text]
hlp_type :: Text
hlp_type :: Help -> Text
hlp_text :: Help -> [Text]
..} = Help
opt_help

optName :: OptEnum -> T.Text
optName :: OptEnum -> Text
optName OptEnum
opt = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
grp forall a. [a] -> [a] -> [a]
++ [Char]
"." forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
2 [Char]
__nme
  where
    ([Char]
grp,[Char]
__nme) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall {t}. Num t => t -> Char -> [Char] -> t
f (-Int
1) Char
' ' [Char]
so) [Char]
so
      where
        f :: t -> Char -> [Char] -> t
f t
i Char
_   []      = t
iforall a. Num a => a -> a -> a
+t
1
        f t
i Char
'_' (Char
'_':[Char]
_) = t
i
        f t
i Char
_    (Char
h:[Char]
t)  = t -> Char -> [Char] -> t
f (t
iforall a. Num a => a -> a -> a
+t
1) Char
h [Char]
t

        so :: [Char]
so              = forall a. Show a => a -> [Char]
show OptEnum
opt

parseOpt :: T.Text -> Maybe OptEnum
parseOpt :: Text -> Maybe OptEnum
parseOpt Text
txt = forall a. [a] -> Maybe a
listToMaybe [ OptEnum
oe | OptEnum
oe<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], OptEnum -> Text
optName OptEnum
oeforall a. Eq a => a -> a -> Bool
==Text
txt ]

backup_opt :: [T.Text] -> OptEnum -> Opt [Name]
backup_opt :: [Text] -> OptEnum -> Opt [Name]
backup_opt [Text]
hp OptEnum
ce =
    Opt
        { opt_enum :: OptEnum
opt_enum    = OptEnum
ce
        , opt_default :: [Name]
opt_default = []
        , opt_from :: Value -> [Name]
opt_from    = Value -> [Name]
frm
        , opt_to :: [Name] -> Value
opt_to      = Array -> Value
Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Char]
_name)
        , opt_help :: Help
opt_help    = [Text] -> Text -> Help
Help [Text]
hp Text
"[<string>]"
        }
  where
    frm :: Value -> [Name]
frm  Value
val =
        case Value
val of
          Array Array
v -> forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Value -> Maybe Name
extr forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Array
v
          Value
_       -> []

    extr :: Value -> Maybe Name
extr Value
val =
        case Value
val of
          String Text
t | Right Name
nm <- [Char] -> Either Reason Name
name forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t -> forall a. a -> Maybe a
Just Name
nm
          Value
_                                        -> forall a. Maybe a
Nothing

bool_opt ::     [T.Text] -> Bool -> OptEnum -> Opt Bool
bool_opt :: [Text] -> Bool -> OptEnum -> Opt Bool
bool_opt [Text]
hp Bool
x0 OptEnum
ce =
    Opt
        { opt_enum :: OptEnum
opt_enum    = OptEnum
ce
        , opt_default :: Bool
opt_default = Bool
x0
        , opt_from :: Value -> Bool
opt_from    = Value -> Bool
frm
        , opt_to :: Bool -> Value
opt_to      = Bool -> Value
Bool
        , opt_help :: Help
opt_help    = [Text] -> Text -> Help
Help [Text]
hp Text
"<boolean>"
        }
  where
    frm :: Value -> Bool
frm Value
v =
        case Value
v of
          Bool Bool
b -> Bool
b
          Value
_      -> Bool
x0

intg_opt :: [T.Text] -> (Int->a,a->Int) -> a -> OptEnum -> Opt a
intg_opt :: forall a. [Text] -> (Int -> a, a -> Int) -> a -> OptEnum -> Opt a
intg_opt [Text]
hp (Int -> a
inj,a -> Int
prj) a
x0 OptEnum
ce =
    Opt
        { opt_enum :: OptEnum
opt_enum    = OptEnum
ce
        , opt_default :: a
opt_default = a
x0
        , opt_from :: Value -> a
opt_from    = Value -> a
frm
        , opt_to :: a -> Value
opt_to      = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
prj
        , opt_help :: Help
opt_help    = [Text] -> Text -> Help
Help [Text]
hp Text
"<integer>"
        }
  where
    frm :: Value -> a
frm Value
v =
        case forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
          Success Int
i -> Int -> a
inj Int
i
          Result Int
_         -> a
x0

text_opt :: [T.Text] -> (T.Text->a,a->T.Text) -> a -> OptEnum -> Opt a
text_opt :: forall a. [Text] -> (Text -> a, a -> Text) -> a -> OptEnum -> Opt a
text_opt [Text]
hp (Text -> a
inj,a -> Text
prj) a
x0 OptEnum
ce =
    Opt
        { opt_enum :: OptEnum
opt_enum    = OptEnum
ce
        , opt_default :: a
opt_default = a
x0
        , opt_from :: Value -> a
opt_from    = Value -> a
frm
        , opt_to :: a -> Value
opt_to      = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
prj
        , opt_help :: Help
opt_help    = [Text] -> Text -> Help
Help [Text]
hp Text
"<string>"
        }
  where
    frm :: Value -> a
frm Value
v =
        case Value
v of
          String Text
t -> Text -> a
inj Text
t
          Value
_        -> a
x0

enum_opt :: (Bounded a,Enum a) => [T.Text] -> (a->T.Text) -> a -> OptEnum -> Opt a
enum_opt :: forall a.
(Bounded a, Enum a) =>
[Text] -> (a -> Text) -> a -> OptEnum -> Opt a
enum_opt [Text]
hp a -> Text
shw a
x0 OptEnum
ce =
    Opt
        { opt_enum :: OptEnum
opt_enum    = OptEnum
ce
        , opt_default :: a
opt_default = a
x0
        , opt_from :: Value -> a
opt_from    = Value -> a
frm
        , opt_to :: a -> Value
opt_to      = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
shw
        , opt_help :: Help
opt_help    = [Text] -> Text -> Help
Help [Text]
hp Text
typ
       }
  where
    frm :: Value -> a
frm Value
v =
        case Value
v of
          String Text
s | Just a
x <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
s Map Text a
mp -> a
x
          Value
_                                    -> a
x0

    mp :: Map Text a
mp    = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (a -> Text
shw a
v,a
v) | a
v<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound] ]

    typ :: Text
typ   = Text -> [Text] -> Text
T.intercalate Text
"|" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> Text
shw [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]

dbg_help, vfy_help, sfx_help, bku_help, hcm_help, hpr_help, hit_help, hwd_help,
    hna_help, ccy_help, cpr_help, cit_help, cna_help :: [T.Text]

dbg_help :: [Text]
dbg_help =
  [Text
"Controls whether debug output is enabled or not."
  ]
vfy_help :: [Text]
vfy_help =
  [ Text
"Controls whether verification mode is enabled or not,"
  , Text
"in which the secret text loaded from environment"
  , Text
"variables is checked against the stored MACs."
  , Text
"These checks can consume a lot of compute time."
  ]
sfx_help :: [Text]
sfx_help =
  [ Text
"Set when a 'Sections' keystore has been fixed so that"
  , Text
"section, key and host names no longer contrained to avoid"
  , Text
"prefixes."
  ]
bku_help :: [Text]
bku_help =
  [ Text
"Controls the default keys that will be used to make secret copies"
  , Text
"(i.e., backup) each key. Each key may individually specify their"
  , Text
"backup/save keys which will operate in addition to those specify here."
  , Text
"This setting usually set to empty globally accross a keystore but"
  , Text
"triggered to backup keys on a per-section basis with the section's"
  , Text
"backup key."
  ]
hcm_help :: [Text]
hcm_help =
  [ Text
"Controls the default comment attribute for hashes."
  ]
hpr_help :: [Text]
hpr_help =
  [ Text
"Controls the default psuedo-random/hash function used in the PBKDF2"
  , Text
"function used to generate the MACs."
  ]
hit_help :: [Text]
hit_help =
  [ Text
"Controls the default number of iterations used in the PBKDF2"
  , Text
"function used to generate the MACs."
  ]
hwd_help :: [Text]
hwd_help =
  [ Text
"Controls the default width (in bytes) of the output of the PBKDF2"
  , Text
"function used to generate the MACs."
  ]
hna_help :: [Text]
hna_help =
  [ Text
"Controls the default width (in bytes) of the salt generated for the PBKDF2"
  , Text
"function used to generate the MACs."
  ]
ccy_help :: [Text]
ccy_help =
  [ Text
"Controls the default cipher used to encrypt the keys."
  ]
cpr_help :: [Text]
cpr_help =
  [ Text
"Controls the default psuedo-random/hash function used in the PBKDF2."
  , Text
"function used to generate the cipher keys."
  ]
cit_help :: [Text]
cit_help =
  [ Text
"Controls the default number of iterations used in the PBKDF2"
  , Text
"function used to generate cipher keys."
  ]
cna_help :: [Text]
cna_help =
  [ Text
"Controls the default width (in bytes) of the salt generated for the PBKDF2"
  , Text
"function used to generate cipher keys."
  ]