{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-unused-imports#-}
module Data.KeyStore.Sections
( SECTIONS(..)
, Code(..)
, Sections(..)
, SectionType(..)
, KeyData(..)
, KeyDataMode(..)
, KeyPredicate
, RetrieveDg(..)
, initialise
, rotate
, rotateIfChanged
, rotate_
, retrieve
, signKeystore
, verifyKeystore
, noKeys
, allKeys
, listKeys
, keyPrededicate
, keyHelp
, sectionHelp
, secretKeySummary
, publicKeySummary
, locateKeys
, keyName
, keyName_
, passwordName
, mkSection
)
where
import Data.KeyStore.IO
import Data.KeyStore.KS
import qualified Data.KeyStore.Types.AesonCompat as A
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import qualified Data.Map as Map
import Data.API.Types
import Data.Maybe
import Data.List
import Data.Char
import Data.Ord
import Data.String
import Data.Monoid
import Control.Lens(over)
import Control.Applicative
import Control.Monad
import Text.Printf
import System.FilePath
import Safe
data SECTIONS h s k = SECTIONS
class (Bounded a,Enum a,Eq a, Ord a,Show a) => Code a where
encode :: a -> String
decode :: String -> Maybe a
decode String
s = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [ a
k | a
k<-[a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound], a -> String
forall a. Code a => a -> String
encode a
kString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
s ]
class (Code h, Code s, Code k) => Sections h s k
| s -> h, k -> h
, h -> s, k -> s
, s -> k, h -> k
where
hostDeploySection :: h -> s
sectionType :: s -> SectionType
superSections :: s -> [s]
keyIsHostIndexed :: k -> Maybe (h->Bool)
keyIsInSection :: k -> s -> Bool
getKeyData :: Maybe h -> s -> k -> IO KeyData
getKeyDataWithMode :: Maybe h -> s -> k -> IO (KeyDataMode,KeyData)
sectionSettings :: Maybe s -> IO Settings
describeKey :: k -> String
describeSection :: s -> String
sectionPWEnvVar :: s -> EnvVar
sectionType = SectionType -> s -> SectionType
forall a b. a -> b -> a
const SectionType
ST_keys
superSections = [s] -> s -> [s]
forall a b. a -> b -> a
const []
keyIsHostIndexed = Maybe (h -> Bool) -> k -> Maybe (h -> Bool)
forall a b. a -> b -> a
const Maybe (h -> Bool)
forall a. Maybe a
Nothing
keyIsInSection = (s -> Bool) -> k -> s -> Bool
forall a b. a -> b -> a
const ((s -> Bool) -> k -> s -> Bool) -> (s -> Bool) -> k -> s -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> s -> Bool
forall a b. a -> b -> a
const Bool
True
getKeyData Maybe h
mb s
s k
k = (KeyDataMode, KeyData) -> KeyData
forall a b. (a, b) -> b
snd ((KeyDataMode, KeyData) -> KeyData)
-> IO (KeyDataMode, KeyData) -> IO KeyData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe h -> s -> k -> IO (KeyDataMode, KeyData)
forall h s k.
Sections h s k =>
Maybe h -> s -> k -> IO (KeyDataMode, KeyData)
getKeyDataWithMode Maybe h
mb s
s k
k
getKeyDataWithMode Maybe h
Nothing s
s = String -> k -> IO (KeyDataMode, KeyData)
forall h s k.
Sections h s k =>
String -> k -> IO (KeyDataMode, KeyData)
get_kd (String -> k -> IO (KeyDataMode, KeyData))
-> String -> k -> IO (KeyDataMode, KeyData)
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Code a => a -> String
encode s
s
getKeyDataWithMode (Just h
h) s
_ = String -> k -> IO (KeyDataMode, KeyData)
forall h s k.
Sections h s k =>
String -> k -> IO (KeyDataMode, KeyData)
get_kd (String -> k -> IO (KeyDataMode, KeyData))
-> String -> k -> IO (KeyDataMode, KeyData)
forall a b. (a -> b) -> a -> b
$ h -> String
forall a. Code a => a -> String
encode h
h
sectionSettings = IO Settings -> Maybe s -> IO Settings
forall a b. a -> b -> a
const (IO Settings -> Maybe s -> IO Settings)
-> IO Settings -> Maybe s -> IO Settings
forall a b. (a -> b) -> a -> b
$ Settings -> IO Settings
forall (m :: * -> *) a. Monad m => a -> m a
return Settings
forall a. Monoid a => a
mempty
describeKey k
k = String
"The '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Code a => a -> String
encode k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' key."
describeSection s
s = String
"The '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Code a => a -> String
encode s
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' Section."
sectionPWEnvVar = Text -> EnvVar
EnvVar (Text -> EnvVar) -> (s -> Text) -> s -> EnvVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"KEY_pw_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (s -> String) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Code a => a -> String
encode
data SectionType
= ST_top
| ST_signing
| ST_keys
deriving (Int -> SectionType -> String -> String
[SectionType] -> String -> String
SectionType -> String
(Int -> SectionType -> String -> String)
-> (SectionType -> String)
-> ([SectionType] -> String -> String)
-> Show SectionType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SectionType] -> String -> String
$cshowList :: [SectionType] -> String -> String
show :: SectionType -> String
$cshow :: SectionType -> String
showsPrec :: Int -> SectionType -> String -> String
$cshowsPrec :: Int -> SectionType -> String -> String
Show,SectionType -> SectionType -> Bool
(SectionType -> SectionType -> Bool)
-> (SectionType -> SectionType -> Bool) -> Eq SectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SectionType -> SectionType -> Bool
$c/= :: SectionType -> SectionType -> Bool
== :: SectionType -> SectionType -> Bool
$c== :: SectionType -> SectionType -> Bool
Eq,Eq SectionType
Eq SectionType
-> (SectionType -> SectionType -> Ordering)
-> (SectionType -> SectionType -> Bool)
-> (SectionType -> SectionType -> Bool)
-> (SectionType -> SectionType -> Bool)
-> (SectionType -> SectionType -> Bool)
-> (SectionType -> SectionType -> SectionType)
-> (SectionType -> SectionType -> SectionType)
-> Ord SectionType
SectionType -> SectionType -> Bool
SectionType -> SectionType -> Ordering
SectionType -> SectionType -> SectionType
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 :: SectionType -> SectionType -> SectionType
$cmin :: SectionType -> SectionType -> SectionType
max :: SectionType -> SectionType -> SectionType
$cmax :: SectionType -> SectionType -> SectionType
>= :: SectionType -> SectionType -> Bool
$c>= :: SectionType -> SectionType -> Bool
> :: SectionType -> SectionType -> Bool
$c> :: SectionType -> SectionType -> Bool
<= :: SectionType -> SectionType -> Bool
$c<= :: SectionType -> SectionType -> Bool
< :: SectionType -> SectionType -> Bool
$c< :: SectionType -> SectionType -> Bool
compare :: SectionType -> SectionType -> Ordering
$ccompare :: SectionType -> SectionType -> Ordering
$cp1Ord :: Eq SectionType
Ord)
data KeyData =
KeyData
{ KeyData -> Identity
kd_identity :: Identity
, :: Comment
, KeyData -> ByteString
kd_secret :: B.ByteString
}
deriving (Int -> KeyData -> String -> String
[KeyData] -> String -> String
KeyData -> String
(Int -> KeyData -> String -> String)
-> (KeyData -> String)
-> ([KeyData] -> String -> String)
-> Show KeyData
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [KeyData] -> String -> String
$cshowList :: [KeyData] -> String -> String
show :: KeyData -> String
$cshow :: KeyData -> String
showsPrec :: Int -> KeyData -> String -> String
$cshowsPrec :: Int -> KeyData -> String -> String
Show,KeyData -> KeyData -> Bool
(KeyData -> KeyData -> Bool)
-> (KeyData -> KeyData -> Bool) -> Eq KeyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyData -> KeyData -> Bool
$c/= :: KeyData -> KeyData -> Bool
== :: KeyData -> KeyData -> Bool
$c== :: KeyData -> KeyData -> Bool
Eq)
data KeyDataMode
= KDM_static
| KDM_random
deriving (KeyDataMode
KeyDataMode -> KeyDataMode -> Bounded KeyDataMode
forall a. a -> a -> Bounded a
maxBound :: KeyDataMode
$cmaxBound :: KeyDataMode
minBound :: KeyDataMode
$cminBound :: KeyDataMode
Bounded,Int -> KeyDataMode
KeyDataMode -> Int
KeyDataMode -> [KeyDataMode]
KeyDataMode -> KeyDataMode
KeyDataMode -> KeyDataMode -> [KeyDataMode]
KeyDataMode -> KeyDataMode -> KeyDataMode -> [KeyDataMode]
(KeyDataMode -> KeyDataMode)
-> (KeyDataMode -> KeyDataMode)
-> (Int -> KeyDataMode)
-> (KeyDataMode -> Int)
-> (KeyDataMode -> [KeyDataMode])
-> (KeyDataMode -> KeyDataMode -> [KeyDataMode])
-> (KeyDataMode -> KeyDataMode -> [KeyDataMode])
-> (KeyDataMode -> KeyDataMode -> KeyDataMode -> [KeyDataMode])
-> Enum KeyDataMode
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 :: KeyDataMode -> KeyDataMode -> KeyDataMode -> [KeyDataMode]
$cenumFromThenTo :: KeyDataMode -> KeyDataMode -> KeyDataMode -> [KeyDataMode]
enumFromTo :: KeyDataMode -> KeyDataMode -> [KeyDataMode]
$cenumFromTo :: KeyDataMode -> KeyDataMode -> [KeyDataMode]
enumFromThen :: KeyDataMode -> KeyDataMode -> [KeyDataMode]
$cenumFromThen :: KeyDataMode -> KeyDataMode -> [KeyDataMode]
enumFrom :: KeyDataMode -> [KeyDataMode]
$cenumFrom :: KeyDataMode -> [KeyDataMode]
fromEnum :: KeyDataMode -> Int
$cfromEnum :: KeyDataMode -> Int
toEnum :: Int -> KeyDataMode
$ctoEnum :: Int -> KeyDataMode
pred :: KeyDataMode -> KeyDataMode
$cpred :: KeyDataMode -> KeyDataMode
succ :: KeyDataMode -> KeyDataMode
$csucc :: KeyDataMode -> KeyDataMode
Enum,KeyDataMode -> KeyDataMode -> Bool
(KeyDataMode -> KeyDataMode -> Bool)
-> (KeyDataMode -> KeyDataMode -> Bool) -> Eq KeyDataMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyDataMode -> KeyDataMode -> Bool
$c/= :: KeyDataMode -> KeyDataMode -> Bool
== :: KeyDataMode -> KeyDataMode -> Bool
$c== :: KeyDataMode -> KeyDataMode -> Bool
Eq,Eq KeyDataMode
Eq KeyDataMode
-> (KeyDataMode -> KeyDataMode -> Ordering)
-> (KeyDataMode -> KeyDataMode -> Bool)
-> (KeyDataMode -> KeyDataMode -> Bool)
-> (KeyDataMode -> KeyDataMode -> Bool)
-> (KeyDataMode -> KeyDataMode -> Bool)
-> (KeyDataMode -> KeyDataMode -> KeyDataMode)
-> (KeyDataMode -> KeyDataMode -> KeyDataMode)
-> Ord KeyDataMode
KeyDataMode -> KeyDataMode -> Bool
KeyDataMode -> KeyDataMode -> Ordering
KeyDataMode -> KeyDataMode -> KeyDataMode
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 :: KeyDataMode -> KeyDataMode -> KeyDataMode
$cmin :: KeyDataMode -> KeyDataMode -> KeyDataMode
max :: KeyDataMode -> KeyDataMode -> KeyDataMode
$cmax :: KeyDataMode -> KeyDataMode -> KeyDataMode
>= :: KeyDataMode -> KeyDataMode -> Bool
$c>= :: KeyDataMode -> KeyDataMode -> Bool
> :: KeyDataMode -> KeyDataMode -> Bool
$c> :: KeyDataMode -> KeyDataMode -> Bool
<= :: KeyDataMode -> KeyDataMode -> Bool
$c<= :: KeyDataMode -> KeyDataMode -> Bool
< :: KeyDataMode -> KeyDataMode -> Bool
$c< :: KeyDataMode -> KeyDataMode -> Bool
compare :: KeyDataMode -> KeyDataMode -> Ordering
$ccompare :: KeyDataMode -> KeyDataMode -> Ordering
$cp1Ord :: Eq KeyDataMode
Ord,Int -> KeyDataMode -> String -> String
[KeyDataMode] -> String -> String
KeyDataMode -> String
(Int -> KeyDataMode -> String -> String)
-> (KeyDataMode -> String)
-> ([KeyDataMode] -> String -> String)
-> Show KeyDataMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [KeyDataMode] -> String -> String
$cshowList :: [KeyDataMode] -> String -> String
show :: KeyDataMode -> String
$cshow :: KeyDataMode -> String
showsPrec :: Int -> KeyDataMode -> String -> String
$cshowsPrec :: Int -> KeyDataMode -> String -> String
Show)
type KeyPredicate h s k = Maybe h -> s -> k -> Bool
type Retrieve a = Either RetrieveDg a
data RetrieveDg
= RDG_key_not_reachable
| RDG_no_such_host_key
deriving (Int -> RetrieveDg -> String -> String
[RetrieveDg] -> String -> String
RetrieveDg -> String
(Int -> RetrieveDg -> String -> String)
-> (RetrieveDg -> String)
-> ([RetrieveDg] -> String -> String)
-> Show RetrieveDg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RetrieveDg] -> String -> String
$cshowList :: [RetrieveDg] -> String -> String
show :: RetrieveDg -> String
$cshow :: RetrieveDg -> String
showsPrec :: Int -> RetrieveDg -> String -> String
$cshowsPrec :: Int -> RetrieveDg -> String -> String
Show,RetrieveDg -> RetrieveDg -> Bool
(RetrieveDg -> RetrieveDg -> Bool)
-> (RetrieveDg -> RetrieveDg -> Bool) -> Eq RetrieveDg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetrieveDg -> RetrieveDg -> Bool
$c/= :: RetrieveDg -> RetrieveDg -> Bool
== :: RetrieveDg -> RetrieveDg -> Bool
$c== :: RetrieveDg -> RetrieveDg -> Bool
Eq,Eq RetrieveDg
Eq RetrieveDg
-> (RetrieveDg -> RetrieveDg -> Ordering)
-> (RetrieveDg -> RetrieveDg -> Bool)
-> (RetrieveDg -> RetrieveDg -> Bool)
-> (RetrieveDg -> RetrieveDg -> Bool)
-> (RetrieveDg -> RetrieveDg -> Bool)
-> (RetrieveDg -> RetrieveDg -> RetrieveDg)
-> (RetrieveDg -> RetrieveDg -> RetrieveDg)
-> Ord RetrieveDg
RetrieveDg -> RetrieveDg -> Bool
RetrieveDg -> RetrieveDg -> Ordering
RetrieveDg -> RetrieveDg -> RetrieveDg
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 :: RetrieveDg -> RetrieveDg -> RetrieveDg
$cmin :: RetrieveDg -> RetrieveDg -> RetrieveDg
max :: RetrieveDg -> RetrieveDg -> RetrieveDg
$cmax :: RetrieveDg -> RetrieveDg -> RetrieveDg
>= :: RetrieveDg -> RetrieveDg -> Bool
$c>= :: RetrieveDg -> RetrieveDg -> Bool
> :: RetrieveDg -> RetrieveDg -> Bool
$c> :: RetrieveDg -> RetrieveDg -> Bool
<= :: RetrieveDg -> RetrieveDg -> Bool
$c<= :: RetrieveDg -> RetrieveDg -> Bool
< :: RetrieveDg -> RetrieveDg -> Bool
$c< :: RetrieveDg -> RetrieveDg -> Bool
compare :: RetrieveDg -> RetrieveDg -> Ordering
$ccompare :: RetrieveDg -> RetrieveDg -> Ordering
$cp1Ord :: Eq RetrieveDg
Ord)
initialise :: Sections h s k => CtxParams -> KeyPredicate h s k -> IO ()
initialise :: CtxParams -> KeyPredicate h s k -> IO ()
initialise CtxParams
cp KeyPredicate h s k
kp = do
Settings
stgs <- Opt Bool -> Bool -> Settings -> Settings
forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt Bool
opt__sections_fix Bool
True (Settings -> Settings) -> IO Settings -> IO Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyPredicate h s k -> Maybe s -> IO Settings
forall h s k.
Sections h s k =>
KeyPredicate h s k -> Maybe s -> IO Settings
scs KeyPredicate h s k
kp Maybe s
forall a. Maybe a
Nothing
String -> Settings -> IO ()
newKeyStore (CtxParams -> String
the_keystore CtxParams
cp) Settings
stgs
IC
ic <- CtxParams -> IO IC
instanceCtx CtxParams
cp
(s -> IO ()) -> [s] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (KeyPredicate h s k -> IC -> s -> IO ()
forall h s k.
Sections h s k =>
KeyPredicate h s k -> IC -> s -> IO ()
mks KeyPredicate h s k
kp IC
ic) [s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound]
IC -> KeyPredicate h s k -> IO ()
forall h s k. Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotate IC
ic KeyPredicate h s k
kp
(Key -> Name) -> [Key] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Name
_key_name ([Key] -> [Name]) -> IO [Key] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO [Key]
keys IC
ic IO [Name] -> ([Name] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Name -> IO ()) -> [Name] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IC -> Name -> IO ()
keyInfo IC
ic)
where
scs :: Sections h s k => KeyPredicate h s k -> Maybe s -> IO Settings
scs :: KeyPredicate h s k -> Maybe s -> IO Settings
scs = (Maybe s -> IO Settings)
-> KeyPredicate h s k -> Maybe s -> IO Settings
forall a b. a -> b -> a
const Maybe s -> IO Settings
forall h s k. Sections h s k => Maybe s -> IO Settings
sectionSettings
mks :: Sections h s k => KeyPredicate h s k -> IC -> s -> IO ()
mks :: KeyPredicate h s k -> IC -> s -> IO ()
mks = (IC -> s -> IO ()) -> KeyPredicate h s k -> IC -> s -> IO ()
forall a b. a -> b -> a
const IC -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> IO ()
mkSection
rotate :: Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotate :: IC -> KeyPredicate h s k -> IO ()
rotate IC
ic = IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
forall h s k.
Sections h s k =>
IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ IC
ic Maybe KeyDataMode
forall a. Maybe a
Nothing Bool
False
rotateIfChanged :: Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotateIfChanged :: IC -> KeyPredicate h s k -> IO ()
rotateIfChanged IC
ic = IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
forall h s k.
Sections h s k =>
IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ IC
ic Maybe KeyDataMode
forall a. Maybe a
Nothing Bool
True
rotate_ :: Sections h s k => IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ :: IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ IC
ic Maybe KeyDataMode
mb Bool
ch KeyPredicate h s k
kp = REFORMAT h s k -> IO () -> IO ()
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Maybe KeyDataMode -> Bool -> IC -> Maybe h -> s -> k -> IO ()
forall h s k.
Sections h s k =>
Maybe KeyDataMode -> Bool -> IC -> Maybe h -> s -> k -> IO ()
rotate' Maybe KeyDataMode
mb Bool
ch IC
ic Maybe h
mb_h s
s k
k | (Maybe h
mb_h,s
s,k
k)<-KeyPredicate h s k -> [(Maybe h, s, k)]
forall h s k.
Sections h s k =>
KeyPredicate h s k -> [(Maybe h, s, k)]
listKeys KeyPredicate h s k
kp ]
where
ic' :: REFORMAT h s k
ic' = KeyPredicate h s k -> IC -> REFORMAT h s k
forall h s k. KeyPredicate h s k -> IC -> REFORMAT h s k
kp_RFT KeyPredicate h s k
kp IC
ic
retrieve :: Sections h s k => IC -> h -> k -> IO (Retrieve [Key])
retrieve :: IC -> h -> k -> IO (Retrieve [Key])
retrieve IC
ic h
h k
k = REFORMAT h s k -> IO (Retrieve [Key]) -> IO (Retrieve [Key])
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
forall s k. REFORMAT h s k
ic' (IO (Retrieve [Key]) -> IO (Retrieve [Key]))
-> IO (Retrieve [Key]) -> IO (Retrieve [Key])
forall a b. (a -> b) -> a -> b
$ (RetrieveDg -> IO (Retrieve [Key]))
-> (Name -> IO (Retrieve [Key]))
-> Either RetrieveDg Name
-> IO (Retrieve [Key])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Retrieve [Key] -> IO (Retrieve [Key])
forall (m :: * -> *) a. Monad m => a -> m a
return (Retrieve [Key] -> IO (Retrieve [Key]))
-> (RetrieveDg -> Retrieve [Key])
-> RetrieveDg
-> IO (Retrieve [Key])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetrieveDg -> Retrieve [Key]
forall a b. a -> Either a b
Left) (\Name
nm->[Key] -> Retrieve [Key]
forall a b. b -> Either a b
Right ([Key] -> Retrieve [Key]) -> IO [Key] -> IO (Retrieve [Key])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> REFORMAT h s k -> Name -> IO [Key]
forall h s k. Sections h s k => REFORMAT h s k -> Name -> IO [Key]
locate_keys REFORMAT h s k
forall s k. REFORMAT h s k
ic' Name
nm) (Either RetrieveDg Name -> IO (Retrieve [Key]))
-> Either RetrieveDg Name -> IO (Retrieve [Key])
forall a b. (a -> b) -> a -> b
$ h -> k -> Either RetrieveDg Name
forall h s k. Sections h s k => h -> k -> Either RetrieveDg Name
keyName h
h k
k
where
ic' :: REFORMAT h s k
ic' = h -> IC -> REFORMAT h s k
forall h s k. h -> IC -> REFORMAT h s k
h_RFT h
h IC
ic
signKeystore :: Sections h s k => IC -> SECTIONS h s k -> IO B.ByteString
signKeystore :: IC -> SECTIONS h s k -> IO ByteString
signKeystore IC
ic SECTIONS h s k
scn = REFORMAT h s k -> IO ByteString -> IO ByteString
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile (CtxParams -> String
the_keystore (CtxParams -> String) -> CtxParams -> String
forall a b. (a -> b) -> a -> b
$ IC -> CtxParams
ic_ctx_params IC
ic) IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IC -> Name -> ByteString -> IO ByteString
sign_ IC
ic (s -> Name
forall h s k. Sections h s k => s -> Name
sgn_nme (s -> Name) -> s -> Name
forall a b. (a -> b) -> a -> b
$ SECTIONS h s k -> s
forall h s k. Sections h s k => SECTIONS h s k -> s
signing_key SECTIONS h s k
scn)
where
ic' :: REFORMAT h s k
ic' = SECTIONS h s k -> IC -> REFORMAT h s k
forall h s k. SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
scn IC
ic
verifyKeystore :: Sections h s k => IC -> SECTIONS h s k -> B.ByteString -> IO Bool
verifyKeystore :: IC -> SECTIONS h s k -> ByteString -> IO Bool
verifyKeystore IC
ic SECTIONS h s k
scn ByteString
sig = REFORMAT h s k -> IO Bool -> IO Bool
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile (CtxParams -> String
the_keystore (CtxParams -> String) -> CtxParams -> String
forall a b. (a -> b) -> a -> b
$ IC -> CtxParams
ic_ctx_params IC
ic) IO ByteString -> (ByteString -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> ByteString -> IO Bool)
-> ByteString -> ByteString -> IO Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IC -> ByteString -> ByteString -> IO Bool
verify_ IC
ic) ByteString
sig
where
ic' :: REFORMAT h s k
ic' = SECTIONS h s k -> IC -> REFORMAT h s k
forall h s k. SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
scn IC
ic
noKeys :: KeyPredicate h s k
noKeys :: KeyPredicate h s k
noKeys Maybe h
_ s
_ k
_ = Bool
False
allKeys :: KeyPredicate h s k
allKeys :: KeyPredicate h s k
allKeys Maybe h
_ s
_ k
_ = Bool
True
listKeys :: Sections h s k => KeyPredicate h s k -> [(Maybe h,s,k)]
listKeys :: KeyPredicate h s k -> [(Maybe h, s, k)]
listKeys KeyPredicate h s k
kp = [ (Maybe h, s, k)
trp | trp :: (Maybe h, s, k)
trp@(Maybe h
mb_h,s
s,k
k)<-[(Maybe h, s, k)]
host_keys[(Maybe h, s, k)] -> [(Maybe h, s, k)] -> [(Maybe h, s, k)]
forall a. [a] -> [a] -> [a]
++[(Maybe h, s, k)]
forall a. [(Maybe a, s, k)]
non_host_keys, KeyPredicate h s k
kp Maybe h
mb_h s
s k
k ]
where
host_keys :: [(Maybe h, s, k)]
host_keys = [ (h -> Maybe h
forall a. a -> Maybe a
Just h
h ,s
s,k
k) | k
k<-[k
forall a. Bounded a => a
minBound..k
forall a. Bounded a => a
maxBound], Just h -> Bool
isp<-[k -> Maybe (h -> Bool)
forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k], h
h<-[h
forall a. Bounded a => a
minBound..h
forall a. Bounded a => a
maxBound], h -> Bool
isp h
h, let s :: s
s = h -> k -> s
forall h s k. Sections h s k => h -> k -> s
key_section h
h k
k ]
non_host_keys :: [(Maybe a, s, k)]
non_host_keys = [ (Maybe a
forall a. Maybe a
Nothing,s
s,k
k) | k
k<-[k
forall a. Bounded a => a
minBound..k
forall a. Bounded a => a
maxBound], Maybe (h -> Bool)
Nothing <-[k -> Maybe (h -> Bool)
forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k], s
s<-[s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound], k -> s -> Bool
forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection k
k s
s ]
keyPrededicate :: Sections h s k => Maybe h -> Maybe s -> Maybe k -> KeyPredicate h s k
keyPrededicate :: Maybe h -> Maybe s -> Maybe k -> KeyPredicate h s k
keyPrededicate Maybe h
mbh Maybe s
mbs Maybe k
mbk Maybe h
mbh_ s
s k
k = Bool
h_ok Bool -> Bool -> Bool
&& Bool
s_ok Bool -> Bool -> Bool
&& Bool
k_ok
where
h_ok :: Bool
h_ok = Bool -> (h -> Bool) -> Maybe h -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\h
h->Bool -> (h -> Bool) -> Maybe h -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (h
hh -> h -> Bool
forall a. Eq a => a -> a -> Bool
==) Maybe h
mbh_) Maybe h
mbh
s_ok :: Bool
s_ok = Bool -> (s -> Bool) -> Maybe s -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (s
ss -> s -> Bool
forall a. Eq a => a -> a -> Bool
==) Maybe s
mbs
k_ok :: Bool
k_ok = Bool -> (k -> Bool) -> Maybe k -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==) Maybe k
mbk
keyHelp :: Sections h s k => Maybe k -> T.Text
keyHelp :: Maybe k -> Text
keyHelp x :: Maybe k
x@Maybe k
Nothing = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (k -> Text) -> [k] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (k -> String) -> k -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> String
forall a. Code a => a -> String
encode) [k
forall a. Bounded a => a
minBound..k
forall a. Bounded a => a
maxBound k -> k -> k
forall a. a -> a -> a
`asTypeOf` Maybe k -> k
forall a. HasCallStack => Maybe a -> a
fromJust Maybe k
x ]
keyHelp (Just k
k) = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
f ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ (,) (k -> String
forall a. Code a => a -> String
encode k
k) String
"" ]
, [ (,) String
" hosts:" String
hln | Just String
hln <- [Maybe String
mb_hln] ]
, [ (,) String
" sections:" String
sln | Maybe String
Nothing <- [Maybe String
mb_hln] ]
]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ k -> String
forall h s k. Sections h s k => k -> String
describeKey k
k) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""]
where
mb_hln :: Maybe String
mb_hln = (h -> Bool) -> String
forall a. Code a => (a -> Bool) -> String
fmt ((h -> Bool) -> String) -> Maybe (h -> Bool) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Maybe (h -> Bool)
forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k
sln :: String
sln = (s -> Bool) -> String
forall a. Code a => (a -> Bool) -> String
fmt ((s -> Bool) -> String) -> (s -> Bool) -> String
forall a b. (a -> b) -> a -> b
$ k -> s -> Bool
forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection k
k
f :: (String, String) -> String
f = (String -> String -> String) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> String) -> (String, String) -> String)
-> (String -> String -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-10s %s"
sectionHelp :: Sections h s k => Maybe s -> IO T.Text
sectionHelp :: Maybe s -> IO Text
sectionHelp x :: Maybe s
x@Maybe s
Nothing = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (s -> Text) -> [s] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Code a => a -> String
encode) [s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound s -> s -> s
forall a. a -> a -> a
`asTypeOf` Maybe s -> s
forall a. HasCallStack => Maybe a -> a
fromJust Maybe s
x ]
sectionHelp (Just s
s) = do
Settings
stgs <- Maybe s -> IO Settings
forall h s k. Sections h s k => Maybe s -> IO Settings
sectionSettings (Maybe s -> IO Settings) -> Maybe s -> IO Settings
forall a b. (a -> b) -> a -> b
$ s -> Maybe s
forall a. a -> Maybe a
Just s
s
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
f ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ (,) (s -> String
forall a. Code a => a -> String
encode s
s) String
typ ]
, [ (,) String
" p/w env var:" String
env ]
, [ (,) String
" hosts:" String
hln ]
, [ (,) String
" super sections:" String
sln ]
, [ (,) String
" under sections:" String
uln ]
, [ (,) String
" keys:" String
kln ]
, [ (,) String
" settings" String
"" ]
]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Settings -> [String]
fmt_s Settings
stgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ s -> String
forall h s k. Sections h s k => s -> String
describeSection s
s) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""]
where
typ :: String
typ = case s -> SectionType
forall h s k. Sections h s k => s -> SectionType
sectionType s
s of
SectionType
ST_top -> String
"(top)"
SectionType
ST_signing -> String
"(signing)"
SectionType
ST_keys -> String
"(keys)"
env :: String
env = String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (EnvVar -> Text
_EnvVar (EnvVar -> Text) -> EnvVar -> Text
forall a b. (a -> b) -> a -> b
$ s -> EnvVar
forall h s k. Sections h s k => s -> EnvVar
sectionPWEnvVar s
s)
hln :: String
hln = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub [ h -> String
forall a. Code a => a -> String
encode h
h | h
h<-[h
forall a. Bounded a => a
minBound..h
forall a. Bounded a => a
maxBound], h -> s
forall h s k. Sections h s k => h -> s
hostDeploySection h
hs -> s -> Bool
forall a. Eq a => a -> a -> Bool
==s
s ]
sln :: String
sln = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (s -> String) -> [s] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map s -> String
forall a. Code a => a -> String
encode ([s] -> [String]) -> [s] -> [String]
forall a b. (a -> b) -> a -> b
$ s -> [s]
forall h s k. Sections h s k => s -> [s]
superSections s
s
uln :: String
uln = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (s -> String) -> [s] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map s -> String
forall a. Code a => a -> String
encode ([s] -> [String]) -> [s] -> [String]
forall a b. (a -> b) -> a -> b
$ [ s
s_ | s
s_<-[s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound], s
s s -> [s] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` s -> [s]
forall h s k. Sections h s k => s -> [s]
superSections s
s_ ]
kln :: String
kln = (k -> Bool) -> String
forall a. Code a => (a -> Bool) -> String
fmt ((k -> Bool) -> String) -> (k -> Bool) -> String
forall a b. (a -> b) -> a -> b
$ (k -> s -> Bool) -> s -> k -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> s -> Bool
forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection s
s
f :: (String, String) -> String
f = (String -> String -> String) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> String) -> (String, String) -> String)
-> (String -> String -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-20s %s"
fmt_s :: Settings -> [String]
fmt_s Settings
stgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
LBS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Object
forall a. HashMap Text a -> KM a
A.intoKM (HashMap Text Value -> Object) -> HashMap Text Value -> Object
forall a b. (a -> b) -> a -> b
$ Settings -> HashMap Text Value
_Settings Settings
stgs
secretKeySummary :: Sections h s k => IC -> SECTIONS h s k -> IO T.Text
secretKeySummary :: IC -> SECTIONS h s k -> IO Text
secretKeySummary IC
ic SECTIONS h s k
scn = REFORMAT h s k -> IO Text -> IO Text
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> IO [Text] -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s -> IO Text) -> [s] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM s -> IO Text
forall h s k. Sections h s k => s -> IO Text
f (SECTIONS h s k -> [s]
forall h s k. Sections h s k => SECTIONS h s k -> [s]
sections SECTIONS h s k
scn)
where
f :: s -> IO Text
f s
s = do
Text
sec <- String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IC -> Bool -> Name -> IO ByteString
showSecret IC
ic Bool
False (Name -> IO ByteString) -> Name -> IO ByteString
forall a b. (a -> b) -> a -> b
$ s -> Name
forall h s k. Sections h s k => s -> Name
passwordName s
s)
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"export ",EnvVar -> Text
_EnvVar (EnvVar -> Text) -> EnvVar -> Text
forall a b. (a -> b) -> a -> b
$ s -> EnvVar
forall h s k. Sections h s k => s -> EnvVar
sectionPWEnvVar s
s,Text
"=",Text
sec]
ic' :: REFORMAT h s k
ic' = SECTIONS h s k -> IC -> REFORMAT h s k
forall h s k. SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
scn IC
ic
publicKeySummary :: Sections h s k => IC -> SECTIONS h s k -> FilePath -> IO T.Text
publicKeySummary :: IC -> SECTIONS h s k -> String -> IO Text
publicKeySummary IC
ic SECTIONS h s k
scn String
fp = REFORMAT h s k -> IO Text -> IO Text
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
f (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> Bool -> Name -> IO ByteString
showPublic IC
ic Bool
True (s -> Name
forall h s k. Sections h s k => s -> Name
sgn_nme (s -> Name) -> s -> Name
forall a b. (a -> b) -> a -> b
$ SECTIONS h s k -> s
forall h s k. Sections h s k => SECTIONS h s k -> s
signing_key SECTIONS h s k
scn)
where
f :: ByteString -> Text
f ByteString
b = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"echo '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
B.unpack ByteString
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' >" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
ic' :: REFORMAT h s k
ic' = SECTIONS h s k -> IC -> REFORMAT h s k
forall h s k. SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
scn IC
ic
locateKeys :: Sections h s k => IC -> SECTIONS h s k -> Name -> IO [Key]
locateKeys :: IC -> SECTIONS h s k -> Name -> IO [Key]
locateKeys IC
ic SECTIONS h s k
scn Name
nm = REFORMAT h s k -> Name -> IO [Key]
forall h s k. Sections h s k => REFORMAT h s k -> Name -> IO [Key]
locate_keys REFORMAT h s k
ic' Name
nm
where
ic' :: REFORMAT h s k
ic' = SECTIONS h s k -> IC -> REFORMAT h s k
forall h s k. SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
scn IC
ic
locate_keys :: Sections h s k => REFORMAT h s k -> Name -> IO [Key]
locate_keys :: REFORMAT h s k -> Name -> IO [Key]
locate_keys REFORMAT h s k
ic' Name
nm = REFORMAT h s k -> IO [Key] -> IO [Key]
forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' (IO [Key] -> IO [Key]) -> IO [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ (Key -> Key -> Ordering) -> [Key] -> [Key]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Key -> Key -> Ordering) -> Key -> Key -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Key -> Key -> Ordering) -> Key -> Key -> Ordering)
-> (Key -> Key -> Ordering) -> Key -> Key -> Ordering
forall a b. (a -> b) -> a -> b
$ (Key -> Name) -> Key -> Key -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Key -> Name
_key_name) ([Key] -> [Key]) -> ([Key] -> [Key]) -> [Key] -> [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter Key -> Bool
yup ([Key] -> [Key]) -> IO [Key] -> IO [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO [Key]
keys IC
ic
where
yup :: Key -> Bool
yup = Name -> Bool
isp (Name -> Bool) -> (Key -> Name) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Name
_key_name
isp :: Name -> Bool
isp Name
nm' = String
nm_s String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name -> String
_name Name
nm'
nm_s :: String
nm_s = Name -> String
_name Name
nm
ic :: IC
ic = REFORMAT h s k -> IC
forall h s k. REFORMAT h s k -> IC
_REFORMAT REFORMAT h s k
ic'
keyName :: Sections h s k => h -> k -> Retrieve Name
keyName :: h -> k -> Either RetrieveDg Name
keyName h
h k
k = do
Maybe h
mb_h <- case k -> Maybe (h -> Bool)
forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k of
Maybe (h -> Bool)
Nothing -> Maybe h -> Either RetrieveDg (Maybe h)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe h
forall a. Maybe a
Nothing
Just h -> Bool
hp | h -> Bool
hp h
h -> Maybe h -> Either RetrieveDg (Maybe h)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe h -> Either RetrieveDg (Maybe h))
-> Maybe h -> Either RetrieveDg (Maybe h)
forall a b. (a -> b) -> a -> b
$ h -> Maybe h
forall a. a -> Maybe a
Just h
h
| Bool
otherwise -> RetrieveDg -> Either RetrieveDg (Maybe h)
forall a b. a -> Either a b
Left RetrieveDg
RDG_no_such_host_key
s
s <- h -> k -> Retrieve s
forall h s k. Sections h s k => h -> k -> Retrieve s
keySection h
h k
k
Name -> Either RetrieveDg Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either RetrieveDg Name) -> Name -> Either RetrieveDg Name
forall a b. (a -> b) -> a -> b
$ Maybe h -> s -> k -> Name
forall h s k. Sections h s k => Maybe h -> s -> k -> Name
keyName_ Maybe h
mb_h s
s k
k
keyName_ :: Sections h s k => Maybe h -> s -> k -> Name
keyName_ :: Maybe h -> s -> k -> Name
keyName_ Maybe h
mb_h s
s k
k = String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Code a => a -> String
encode s
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Code a => a -> String
encode k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hst_sfx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
where
hst_sfx :: String
hst_sfx = String -> (h -> String) -> Maybe h -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\h
h -> String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ h -> String
forall a. Code a => a -> String
encode h
h) Maybe h
mb_h
key_section :: Sections h s k => h -> k -> s
key_section :: h -> k -> s
key_section h
h k
k = (RetrieveDg -> s) -> (s -> s) -> Either RetrieveDg s -> s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RetrieveDg -> s
forall a a. Show a => a -> a
oops s -> s
forall a. a -> a
id (Either RetrieveDg s -> s) -> Either RetrieveDg s -> s
forall a b. (a -> b) -> a -> b
$ h -> k -> Either RetrieveDg s
forall h s k. Sections h s k => h -> k -> Retrieve s
keySection h
h k
k
where
oops :: a -> a
oops a
dg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"key_section: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ h -> String
forall a. Code a => a -> String
encode h
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Code a => a -> String
encode k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
dg
keySection :: Sections h s k => h -> k -> Retrieve s
keySection :: h -> k -> Retrieve s
keySection h
h k
k = Retrieve s -> (s -> Retrieve s) -> Maybe s -> Retrieve s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RetrieveDg -> Retrieve s
forall a b. a -> Either a b
Left RetrieveDg
RDG_key_not_reachable) s -> Retrieve s
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe s -> Retrieve s) -> Maybe s -> Retrieve s
forall a b. (a -> b) -> a -> b
$ [s] -> Maybe s
forall a. [a] -> Maybe a
listToMaybe ([s] -> Maybe s) -> [s] -> Maybe s
forall a b. (a -> b) -> a -> b
$
(s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter (k -> s -> Bool
forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection k
k) ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ s -> [s]
forall h s k. Sections h s k => s -> [s]
lower_sections (s -> [s]) -> s -> [s]
forall a b. (a -> b) -> a -> b
$ h -> s
forall h s k. Sections h s k => h -> s
hostDeploySection h
h
passwordName :: Sections h s k => s -> Name
passwordName :: s -> Name
passwordName s
s = String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"/pw/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Code a => a -> String
encode s
s
fmt :: Code a => (a->Bool) -> String
fmt :: (a -> Bool) -> String
fmt a -> Bool
p = [String] -> String
unwords [ a -> String
forall a. Code a => a -> String
encode a
h | a
h<-[a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound], a -> Bool
p a
h ]
rotate' :: Sections h s k => Maybe KeyDataMode -> Bool -> IC -> Maybe h -> s -> k -> IO ()
rotate' :: Maybe KeyDataMode -> Bool -> IC -> Maybe h -> s -> k -> IO ()
rotate' Maybe KeyDataMode
mb Bool
ch IC
ic Maybe h
mb_h s
s k
k = do
(KeyDataMode
kdm,kd :: KeyData
kd@KeyData{ByteString
Comment
Identity
kd_secret :: ByteString
kd_comment :: Comment
kd_identity :: Identity
kd_secret :: KeyData -> ByteString
kd_comment :: KeyData -> Comment
kd_identity :: KeyData -> Identity
..}) <- Maybe h -> s -> k -> IO (KeyDataMode, KeyData)
forall h s k.
Sections h s k =>
Maybe h -> s -> k -> IO (KeyDataMode, KeyData)
getKeyDataWithMode Maybe h
mb_h s
s k
k
case Bool -> (KeyDataMode -> Bool) -> Maybe KeyDataMode -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (KeyDataMode -> KeyDataMode -> Bool
forall a. Eq a => a -> a -> Bool
==KeyDataMode
kdm) Maybe KeyDataMode
mb of
Bool
True -> do
Bool
ok <- case Bool
ch of
Bool
True -> do
[Maybe KeyData]
mbkds <- (Key -> Maybe KeyData) -> [Key] -> [Maybe KeyData]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Maybe KeyData
key2KeyData ([Key] -> [Maybe KeyData]) -> IO [Key] -> IO [Maybe KeyData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> SECTIONS h s k -> Name -> IO [Key]
forall h s k.
Sections h s k =>
IC -> SECTIONS h s k -> Name -> IO [Key]
locateKeys IC
ic (k -> SECTIONS h s k
forall k h s. k -> SECTIONS h s k
mks k
k) Name
g_nm
case [Maybe KeyData]
mbkds of
Just KeyData
kd':[Maybe KeyData]
_ | KeyData
kdKeyData -> KeyData -> Bool
forall a. Eq a => a -> a -> Bool
==KeyData
kd' -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Maybe KeyData
Nothing :[Maybe KeyData]
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[Maybe KeyData]
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False ->
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Name
n_nm <- IC -> Name -> IO Name
unique_nme IC
ic Name
g_nm
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"rotating: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
_name Name
n_nm
IC
-> Name
-> Comment
-> Identity
-> Maybe EnvVar
-> Maybe ByteString
-> IO ()
createKey IC
ic Name
n_nm Comment
kd_comment Identity
kd_identity Maybe EnvVar
forall a. Maybe a
Nothing (Maybe ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
kd_secret
Bool
False ->
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
g_nm :: Name
g_nm = Maybe h -> s -> k -> Name
forall h s k. Sections h s k => Maybe h -> s -> k -> Name
keyName_ Maybe h
mb_h s
s k
k
mks :: k -> SECTIONS h s k
mks :: k -> SECTIONS h s k
mks = SECTIONS h s k -> k -> SECTIONS h s k
forall a b. a -> b -> a
const SECTIONS h s k
forall h s k. SECTIONS h s k
SECTIONS
lower_sections :: Sections h s k => s -> [s]
lower_sections :: s -> [s]
lower_sections s
s0 =
s
s0 s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [[s]] -> [s]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:s -> [s]
forall h s k. Sections h s k => s -> [s]
lower_sections s
s | s
s<-[s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound], s
s0 s -> [s] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` s -> [s]
forall h s k. Sections h s k => s -> [s]
superSections s
s ]
mkSection :: Sections h s k => IC -> s -> IO ()
mkSection :: IC -> s -> IO ()
mkSection IC
ic s
s = do
IC -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> IO ()
mk_section IC
ic s
s
case s -> SectionType
forall h s k. Sections h s k => s -> SectionType
sectionType s
s of
SectionType
ST_top -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
SectionType
ST_signing -> IC -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> IO ()
add_signing IC
ic s
s
SectionType
ST_keys -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mk_section :: Sections h s k => IC -> s -> IO ()
mk_section :: IC -> s -> IO ()
mk_section IC
ic s
s =
do IC -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> IO ()
add_password IC
ic s
s
IC -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> IO ()
add_save_key IC
ic s
s
IC -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> IO ()
add_trigger IC
ic s
s
(s -> IO ()) -> [s] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IC -> s -> s -> IO ()
forall h s k. Sections h s k => IC -> s -> s -> IO ()
backup_password IC
ic s
s) ([s] -> IO ()) -> [s] -> IO ()
forall a b. (a -> b) -> a -> b
$ s -> [s]
forall h s k. Sections h s k => s -> [s]
superSections s
s
add_signing :: Sections h s k => IC -> s -> IO ()
add_signing :: IC -> s -> IO ()
add_signing IC
ic s
s = IC -> Name -> Comment -> Identity -> [Safeguard] -> IO ()
createRSAKeyPair IC
ic (s -> Name
forall h s k. Sections h s k => s -> Name
sgn_nme s
s) Comment
cmt Identity
"" [Safeguard
pw_sg]
where
cmt :: Comment
cmt = Text -> Comment
Comment (Text -> Comment) -> Text -> Comment
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"signing key"
pw_sg :: Safeguard
pw_sg = [Name] -> Safeguard
safeguard [s -> Name
forall h s k. Sections h s k => s -> Name
passwordName s
s]
add_password :: Sections h s k => IC -> s -> IO ()
add_password :: IC -> s -> IO ()
add_password IC
ic s
s = IC
-> Name
-> Comment
-> Identity
-> Maybe EnvVar
-> Maybe ByteString
-> IO ()
createKey IC
ic Name
nm Comment
cmt Identity
ide (EnvVar -> Maybe EnvVar
forall a. a -> Maybe a
Just EnvVar
ev) Maybe ByteString
forall a. Maybe a
Nothing
where
cmt :: Comment
cmt = Text -> Comment
Comment (Text -> Comment) -> Text -> Comment
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"password for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Code a => a -> String
encode s
s
ide :: Identity
ide = Identity
""
ev :: EnvVar
ev = s -> EnvVar
forall h s k. Sections h s k => s -> EnvVar
sectionPWEnvVar s
s
nm :: Name
nm = s -> Name
forall h s k. Sections h s k => s -> Name
passwordName s
s
add_save_key :: Sections h s k => IC -> s -> IO ()
add_save_key :: IC -> s -> IO ()
add_save_key IC
ic s
s = IC -> Name -> Comment -> Identity -> [Safeguard] -> IO ()
createRSAKeyPair IC
ic Name
nm Comment
cmt Identity
ide [Safeguard
pw_sg]
where
nm :: Name
nm = s -> Name
forall h s k. Sections h s k => s -> Name
sve_nme s
s
cmt :: Comment
cmt = Text -> Comment
Comment (Text -> Comment) -> Text -> Comment
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"save key for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Code a => a -> String
encode s
s
ide :: Identity
ide = Identity
""
pw_sg :: Safeguard
pw_sg = [Name] -> Safeguard
safeguard [s -> Name
forall h s k. Sections h s k => s -> Name
passwordName s
s]
add_trigger :: Sections h s k => IC -> s -> IO ()
add_trigger :: IC -> s -> IO ()
add_trigger IC
ic s
s = do
Settings
stgs <- (s -> Settings
forall h s k. Sections h s k => s -> Settings
bu_settings s
s Settings -> Settings -> Settings
forall a. Semigroup a => a -> a -> a
<>) (Settings -> Settings) -> IO Settings -> IO Settings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s -> IO Settings
forall h s k. Sections h s k => Maybe s -> IO Settings
sectionSettings (s -> Maybe s
forall a. a -> Maybe a
Just s
s)
IC -> TriggerID -> Pattern -> Settings -> IO ()
addTrigger' IC
ic TriggerID
tid Pattern
pat Settings
stgs
where
tid :: TriggerID
tid = Text -> TriggerID
TriggerID (Text -> TriggerID) -> Text -> TriggerID
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Code a => a -> String
encode s
s
pat :: Pattern
pat = s -> Pattern
forall h s k. Sections h s k => s -> Pattern
scn_pattern s
s
bu_settings :: Sections h s k => s -> Settings
bu_settings :: s -> Settings
bu_settings s
s = HashMap Text Value -> Settings
Settings (HashMap Text Value -> Settings) -> HashMap Text Value -> Settings
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
[ (Text
"backup.keys"
, Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Array
forall a. a -> Vector a
V.singleton (Value -> Array) -> Value -> Array
forall a b. (a -> b) -> a -> b
$ Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
_name (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ s -> Name
forall h s k. Sections h s k => s -> Name
sve_nme s
s
)
]
signing_key :: Sections h s k => SECTIONS h s k -> s
signing_key :: SECTIONS h s k -> s
signing_key SECTIONS h s k
_ = s -> (s -> s) -> Maybe s -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
forall a. a
oops s -> s
forall a. a -> a
id (Maybe s -> s) -> Maybe s -> s
forall a b. (a -> b) -> a -> b
$ [s] -> Maybe s
forall a. [a] -> Maybe a
listToMaybe [ s
s_ | s
s_<-[s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound], s -> SectionType
forall h s k. Sections h s k => s -> SectionType
sectionType s
s_ SectionType -> SectionType -> Bool
forall a. Eq a => a -> a -> Bool
== SectionType
ST_signing ]
where
oops :: a
oops = String -> a
forall a. HasCallStack => String -> a
error String
"signing_key: there is no signing key!"
sections :: Sections h s k => SECTIONS h s k -> [s]
sections :: SECTIONS h s k -> [s]
sections SECTIONS h s k
_ = [s
forall a. Bounded a => a
minBound..s
forall a. Bounded a => a
maxBound]
backup_password :: Sections h s k => IC -> s -> s -> IO ()
backup_password :: IC -> s -> s -> IO ()
backup_password IC
ic s
s s
sv_s = IC -> Name -> Safeguard -> IO ()
secureKey IC
ic (s -> Name
forall h s k. Sections h s k => s -> Name
passwordName s
s) (Safeguard -> IO ()) -> Safeguard -> IO ()
forall a b. (a -> b) -> a -> b
$ [Name] -> Safeguard
safeguard [s -> Name
forall h s k. Sections h s k => s -> Name
sve_nme s
sv_s]
sgn_nme :: Sections h s k => s -> Name
sgn_nme :: s -> Name
sgn_nme s
s = String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Code a => a -> String
encode s
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/keystore_signing_key"
sve_nme :: Sections h s k => s -> Name
sve_nme :: s -> Name
sve_nme s
s = String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"/save/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Code a => a -> String
encode s
s
scn_pattern :: Sections h s k => s -> Pattern
scn_pattern :: s -> Pattern
scn_pattern s
s = String -> Pattern
pattern (String -> Pattern) -> String -> Pattern
forall a b. (a -> b) -> a -> b
$ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Code a => a -> String
encode s
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/.*"
unique_nme :: IC -> Name -> IO Name
unique_nme :: IC -> Name -> IO Name
unique_nme IC
ic Name
nm =
do [Name]
nms <- (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isp ([Name] -> [Name]) -> ([Key] -> [Name]) -> [Key] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Name) -> [Key] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Name
_key_name ([Key] -> [Name]) -> IO [Key] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO [Key]
keys IC
ic
Name -> IO Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> IO Name) -> Name -> IO Name
forall a b. (a -> b) -> a -> b
$ [Name] -> Name -> Name
unique_nme' [Name]
nms Name
nm
where
isp :: Name -> Bool
isp Name
nm' = Name -> String
_name Name
nm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name -> String
_name Name
nm'
unique_nme' :: [Name] -> Name -> Name
unique_nme' :: [Name] -> Name -> Name
unique_nme' [Name]
nms Name
nm0 = String -> [Name] -> Name
forall a. HasCallStack => String -> [a] -> a
headNote String
"unique_name'" [Name]
c_nms
where
c_nms :: [Name]
c_nms = [ Name
nm | Int
i<-[[Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
nmsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..], let nm :: Name
nm=Int -> Name -> Name
nname Int
i Name
nm0, Name
nm Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
nms ]
nname :: Int -> Name -> Name
nname :: Int -> Name -> Name
nname Int
i Name
nm_ = String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Name -> String
_name Name
nm_ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03d" Int
i
the_keystore :: CtxParams -> FilePath
the_keystore :: CtxParams -> String
the_keystore = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"keystore.json" String -> String
forall a. a -> a
id (Maybe String -> String)
-> (CtxParams -> Maybe String) -> CtxParams -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtxParams -> Maybe String
cp_store
get_kd :: Sections h s k => String -> k -> IO (KeyDataMode,KeyData)
get_kd :: String -> k -> IO (KeyDataMode, KeyData)
get_kd String
sd k
k = do
ByteString
ide <- String -> IO ByteString
B.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> String
fp String
"_id"
ByteString
cmt <- String -> IO ByteString
B.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> String
fp String
"_cmt"
ByteString
sec <- String -> IO ByteString
B.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> String
fp String
""
(KeyDataMode, KeyData) -> IO (KeyDataMode, KeyData)
forall (m :: * -> *) a. Monad m => a -> m a
return
( KeyDataMode
KDM_static
, KeyData :: Identity -> Comment -> ByteString -> KeyData
KeyData
{ kd_identity :: Identity
kd_identity = Text -> Identity
Identity (Text -> Identity) -> Text -> Identity
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
ide
, kd_comment :: Comment
kd_comment = Text -> Comment
Comment (Text -> Comment) -> Text -> Comment
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
cmt
, kd_secret :: ByteString
kd_secret = ByteString
sec
}
)
where
fp :: String -> String
fp String
sfx = String
sd String -> String -> String
</> k -> String
forall a. Code a => a -> String
encode k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sfx
reformat :: Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat :: REFORMAT h s k -> IO a -> IO a
reformat rft :: REFORMAT h s k
rft@(REFORMAT IC
ic) IO a
p = Encoding -> IC -> IO ()
reformat_ic (REFORMAT h s k -> Encoding
forall h s k. Sections h s k => REFORMAT h s k -> Encoding
encoding REFORMAT h s k
rft) IC
ic IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
p
data REFORMAT h s k = REFORMAT { REFORMAT h s k -> IC
_REFORMAT :: IC }
data CODE a = CODE
scn_RFT :: SECTIONS h s k -> IC -> REFORMAT h s k
kp_RFT :: KeyPredicate h s k -> IC -> REFORMAT h s k
h_RFT :: h -> IC -> REFORMAT h s k
scn_RFT :: SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
_ IC
ic = IC -> REFORMAT h s k
forall h s k. IC -> REFORMAT h s k
REFORMAT IC
ic
kp_RFT :: KeyPredicate h s k -> IC -> REFORMAT h s k
kp_RFT KeyPredicate h s k
_ IC
ic = IC -> REFORMAT h s k
forall h s k. IC -> REFORMAT h s k
REFORMAT IC
ic
h_RFT :: h -> IC -> REFORMAT h s k
h_RFT h
_ IC
ic = IC -> REFORMAT h s k
forall h s k. IC -> REFORMAT h s k
REFORMAT IC
ic
reformat_ic :: Encoding -> IC -> IO ()
reformat_ic :: Encoding -> IC -> IO ()
reformat_ic Encoding
enc IC
ic = do
(Ctx
ctx,State
st) <- IC -> IO (Ctx, State)
getCtxState IC
ic
IC -> Ctx -> State -> IO ()
putCtxState IC
ic Ctx
ctx (State -> IO ()) -> State -> IO ()
forall a b. (a -> b) -> a -> b
$
State
st { st_keystore :: KeyStore
st_keystore = Encoding -> KeyStore -> KeyStore
reformat_keystore Encoding
enc (KeyStore -> KeyStore) -> KeyStore -> KeyStore
forall a b. (a -> b) -> a -> b
$ State -> KeyStore
st_keystore State
st }
reformat_keystore :: Encoding -> KeyStore -> KeyStore
reformat_keystore :: Encoding -> KeyStore -> KeyStore
reformat_keystore Encoding
enc KeyStore
ks =
case Opt Bool -> Settings -> Bool
forall a. Opt a -> Settings -> a
getSettingsOpt Opt Bool
opt__sections_fix (Settings -> Bool) -> Settings -> Bool
forall a b. (a -> b) -> a -> b
$ Configuration -> Settings
_cfg_settings (Configuration -> Settings) -> Configuration -> Settings
forall a b. (a -> b) -> a -> b
$ KeyStore -> Configuration
_ks_config KeyStore
ks of
Bool
True -> KeyStore
ks
Bool
False -> ASetter KeyStore KeyStore Configuration Configuration
-> (Configuration -> Configuration) -> KeyStore -> KeyStore
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter KeyStore KeyStore Configuration Configuration
Lens' KeyStore Configuration
ks_config (Encoding -> Configuration -> Configuration
reformat_config Encoding
enc) (KeyStore -> KeyStore) -> KeyStore -> KeyStore
forall a b. (a -> b) -> a -> b
$
ASetter KeyStore KeyStore KeyMap KeyMap
-> (KeyMap -> KeyMap) -> KeyStore -> KeyStore
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter KeyStore KeyStore KeyMap KeyMap
Lens' KeyStore KeyMap
ks_keymap (Encoding -> KeyMap -> KeyMap
reformat_key_map Encoding
enc) KeyStore
ks
reformat_config :: Encoding -> Configuration -> Configuration
reformat_config :: Encoding -> Configuration -> Configuration
reformat_config Encoding
enc =
ASetter Configuration Configuration Settings Settings
-> (Settings -> Settings) -> Configuration -> Configuration
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Configuration Configuration Settings Settings
Lens' Configuration Settings
cfg_settings (Opt Bool -> Bool -> Settings -> Settings
forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt Bool
opt__sections_fix Bool
True) (Configuration -> Configuration)
-> (Configuration -> Configuration)
-> Configuration
-> Configuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ASetter Configuration Configuration Settings Settings
-> (Settings -> Settings) -> Configuration -> Configuration
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Configuration Configuration Settings Settings
Lens' Configuration Settings
cfg_settings (Encoding -> Settings -> Settings
reformat_settings Encoding
enc) (Configuration -> Configuration)
-> (Configuration -> Configuration)
-> Configuration
-> Configuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ASetter Configuration Configuration TriggerMap TriggerMap
-> (TriggerMap -> TriggerMap) -> Configuration -> Configuration
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Configuration Configuration TriggerMap TriggerMap
Lens' Configuration TriggerMap
cfg_triggers (Encoding -> TriggerMap -> TriggerMap
reformat_triggers Encoding
enc)
reformat_triggers :: Encoding -> TriggerMap -> TriggerMap
reformat_triggers :: Encoding -> TriggerMap -> TriggerMap
reformat_triggers Encoding
enc = (Trigger -> Trigger) -> TriggerMap -> TriggerMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Trigger -> Trigger) -> TriggerMap -> TriggerMap)
-> (Trigger -> Trigger) -> TriggerMap -> TriggerMap
forall a b. (a -> b) -> a -> b
$
ASetter Trigger Trigger Pattern Pattern
-> (Pattern -> Pattern) -> Trigger -> Trigger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Trigger Trigger Pattern Pattern
Lens' Trigger Pattern
trg_pattern (Encoding -> Pattern -> Pattern
reformat_pattern Encoding
enc) (Trigger -> Trigger) -> (Trigger -> Trigger) -> Trigger -> Trigger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ASetter Trigger Trigger Settings Settings
-> (Settings -> Settings) -> Trigger -> Trigger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Trigger Trigger Settings Settings
Lens' Trigger Settings
trg_settings (Encoding -> Settings -> Settings
reformat_settings Encoding
enc)
reformat_settings :: Encoding -> Settings -> Settings
reformat_settings :: Encoding -> Settings -> Settings
reformat_settings Encoding
enc Settings
stgs =
case Opt [Name] -> Settings -> Maybe [Name]
forall a. Opt a -> Settings -> Maybe a
getSettingsOpt' Opt [Name]
opt__backup_keys Settings
stgs of
Maybe [Name]
Nothing -> Settings
stgs
Just [Name]
nms -> Opt [Name] -> [Name] -> Settings -> Settings
forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt [Name]
opt__backup_keys ((Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Encoding -> Name -> Name
reformat_name Encoding
enc) [Name]
nms) Settings
stgs
reformat_pattern :: Encoding -> Pattern -> Pattern
reformat_pattern :: Encoding -> Pattern -> Pattern
reformat_pattern Encoding
enc Pattern
pat = Pattern -> (Pattern -> Pattern) -> Maybe Pattern -> Pattern
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pattern
forall a. a
oops Pattern -> Pattern
forall a. a -> a
id (Maybe Pattern -> Pattern) -> Maybe Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Munch Pattern -> String -> Maybe Pattern
forall a. Munch a -> String -> Maybe a
run_munch (Encoding -> Munch Pattern
m_pattern Encoding
enc) (String -> Maybe Pattern) -> String -> Maybe Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> String
_pat_string Pattern
pat
where
oops :: a
oops = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"reformat_pattern: bad pattern format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pattern -> String
_pat_string Pattern
pat
reformat_key_map :: Encoding -> KeyMap -> KeyMap
reformat_key_map :: Encoding -> KeyMap -> KeyMap
reformat_key_map Encoding
enc KeyMap
km = [(Name, Key)] -> KeyMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Encoding -> Name -> Name
reformat_name Encoding
enc Name
nm,Key -> Key
r_ky Key
ky) | (Name
nm,Key
ky)<-KeyMap -> [(Name, Key)]
forall k a. Map k a -> [(k, a)]
Map.toList KeyMap
km ]
where
r_ky :: Key -> Key
r_ky =
ASetter Key Key Name Name -> (Name -> Name) -> Key -> Key
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Key Key Name Name
Lens' Key Name
key_name (Encoding -> Name -> Name
reformat_name Encoding
enc) (Key -> Key) -> (Key -> Key) -> Key -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ASetter Key Key EncrypedCopyMap EncrypedCopyMap
-> (EncrypedCopyMap -> EncrypedCopyMap) -> Key -> Key
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Key Key EncrypedCopyMap EncrypedCopyMap
Lens' Key EncrypedCopyMap
key_secret_copies (Encoding -> EncrypedCopyMap -> EncrypedCopyMap
reformat_ecm Encoding
enc)
reformat_ecm :: Encoding -> EncrypedCopyMap -> EncrypedCopyMap
reformat_ecm :: Encoding -> EncrypedCopyMap -> EncrypedCopyMap
reformat_ecm Encoding
enc EncrypedCopyMap
ecm = [(Safeguard, EncrypedCopy)] -> EncrypedCopyMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Encoding -> Safeguard -> Safeguard
reformat_sg Encoding
enc Safeguard
sg,EncrypedCopy -> EncrypedCopy
r_ec EncrypedCopy
ec) | (Safeguard
sg,EncrypedCopy
ec)<-EncrypedCopyMap -> [(Safeguard, EncrypedCopy)]
forall k a. Map k a -> [(k, a)]
Map.toList EncrypedCopyMap
ecm ]
where
r_ec :: EncrypedCopy -> EncrypedCopy
r_ec = ASetter EncrypedCopy EncrypedCopy Safeguard Safeguard
-> (Safeguard -> Safeguard) -> EncrypedCopy -> EncrypedCopy
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EncrypedCopy EncrypedCopy Safeguard Safeguard
Lens' EncrypedCopy Safeguard
ec_safeguard (Encoding -> Safeguard -> Safeguard
reformat_sg Encoding
enc)
reformat_sg :: Encoding -> Safeguard -> Safeguard
reformat_sg :: Encoding -> Safeguard -> Safeguard
reformat_sg Encoding
enc = [Name] -> Safeguard
safeguard ([Name] -> Safeguard)
-> (Safeguard -> [Name]) -> Safeguard -> Safeguard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Encoding -> Name -> Name
reformat_name Encoding
enc) ([Name] -> [Name]) -> (Safeguard -> [Name]) -> Safeguard -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Safeguard -> [Name]
safeguardKeys
reformat_name :: Encoding -> Name -> Name
reformat_name :: Encoding -> Name -> Name
reformat_name Encoding
enc Name
nm = Name -> (Name -> Name) -> Maybe Name -> Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Name
forall a. a
oops Name -> Name
forall a. a -> a
id (Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$ Munch Name -> String -> Maybe Name
forall a. Munch a -> String -> Maybe a
run_munch (Encoding -> Munch Name
m_name Encoding
enc) (String -> Maybe Name) -> String -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Name -> String
_name Name
nm
where
oops :: a
oops = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"reformat_name: bad name format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
_name Name
nm
m_pattern :: Encoding -> Munch Pattern
m_pattern :: Encoding -> Munch Pattern
m_pattern Encoding
enc = do
String -> Munch ()
munch_ String
"^"
String
s <- Encoding -> Munch String
enc_s Encoding
enc
String -> Munch ()
munch_ String
"_.*"
Pattern -> Munch Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Munch Pattern) -> Pattern -> Munch Pattern
forall a b. (a -> b) -> a -> b
$ String -> Pattern
forall a. IsString a => String -> a
fromString (String -> Pattern) -> String -> Pattern
forall a b. (a -> b) -> a -> b
$ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/.*"
m_name, m_save, m_pw, m_section :: Encoding -> Munch Name
m_name :: Encoding -> Munch Name
m_name Encoding
enc = Encoding -> Munch Name
m_save Encoding
enc Munch Name -> Munch Name -> Munch Name
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> Munch Name
m_pw Encoding
enc Munch Name -> Munch Name -> Munch Name
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> Munch Name
m_section Encoding
enc
m_save :: Encoding -> Munch Name
m_save Encoding
enc = do
String -> Munch ()
munch_ String
"save_"
String
s <- Encoding -> Munch String
enc_s Encoding
enc
Name -> Munch Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Munch Name) -> Name -> Munch Name
forall a b. (a -> b) -> a -> b
$ String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"/save/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
m_pw :: Encoding -> Munch Name
m_pw Encoding
enc = do
String -> Munch ()
munch_ String
"pw_"
String
s <- Encoding -> Munch String
enc_s Encoding
enc
Name -> Munch Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Munch Name) -> Name -> Munch Name
forall a b. (a -> b) -> a -> b
$ String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"/pw/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
m_section :: Encoding -> Munch Name
m_section Encoding
enc = do
String
s <- Encoding -> Munch String
enc_s Encoding
enc
Encoding -> String -> Munch Name
m_section_signing Encoding
enc String
s Munch Name -> Munch Name -> Munch Name
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> String -> Munch Name
m_section_key Encoding
enc String
s
m_section_key, m_section_signing :: Encoding -> String -> Munch Name
m_section_signing :: Encoding -> String -> Munch Name
m_section_signing Encoding
_ String
s = do
String -> Munch ()
munch_ String
"_keystore_signing_key"
Name -> Munch Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Munch Name) -> Name -> Munch Name
forall a b. (a -> b) -> a -> b
$ String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/keystore_signing_key"
m_section_key :: Encoding -> String -> Munch Name
m_section_key Encoding
enc String
s = do
String -> Munch ()
munch_ String
"_"
String
k <- Encoding -> Munch String
enc_k Encoding
enc
Encoding -> String -> String -> Munch Name
m_section_key_host Encoding
enc String
s String
k Munch Name -> Munch Name -> Munch Name
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> String -> String -> Munch Name
m_section_key_vrn Encoding
enc String
s String
k
m_section_key_vrn, m_section_key_host :: Encoding -> String -> String -> Munch Name
m_section_key_vrn :: Encoding -> String -> String -> Munch Name
m_section_key_vrn Encoding
_ String
s String
k = do
String -> Munch ()
munch_ String
"_"
String
v <- Munch String
munch_vrn
Name -> Munch Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Munch Name) -> Name -> Munch Name
forall a b. (a -> b) -> a -> b
$ String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v
m_section_key_host :: Encoding -> String -> String -> Munch Name
m_section_key_host Encoding
enc String
s String
k = do
String -> Munch ()
munch_ String
"_"
String
h <- Encoding -> Munch String
enc_h Encoding
enc
String -> Munch ()
munch_ String
"_"
String
v <- Munch String
munch_vrn
Name -> Munch Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Munch Name) -> Name -> Munch Name
forall a b. (a -> b) -> a -> b
$ String -> Name
name' (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v
munch_vrn :: Munch String
munch_vrn :: Munch String
munch_vrn = do
Char
c1 <- (Char -> Bool) -> Munch Char
munch1 Char -> Bool
isDigit
Char
c2 <- (Char -> Bool) -> Munch Char
munch1 Char -> Bool
isDigit
Char
c3 <- (Char -> Bool) -> Munch Char
munch1 Char -> Bool
isDigit
String -> Munch String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c1,Char
c2,Char
c3]
data Encoding =
Encoding
{ Encoding -> Munch String
enc_h, Encoding -> Munch String
enc_s, Encoding -> Munch String
enc_k :: Munch String
}
encoding :: Sections h s k => REFORMAT h s k -> Encoding
encoding :: REFORMAT h s k -> Encoding
encoding REFORMAT h s k
rft =
Encoding :: Munch String -> Munch String -> Munch String -> Encoding
Encoding
{ enc_h :: Munch String
enc_h = CODE h -> Munch String
forall a. Code a => CODE a -> Munch String
code_m (CODE h -> Munch String) -> CODE h -> Munch String
forall a b. (a -> b) -> a -> b
$ REFORMAT h s k -> CODE h
forall h s k. Sections h s k => REFORMAT h s k -> CODE h
host_c REFORMAT h s k
rft
, enc_s :: Munch String
enc_s = CODE s -> Munch String
forall a. Code a => CODE a -> Munch String
code_m (CODE s -> Munch String) -> CODE s -> Munch String
forall a b. (a -> b) -> a -> b
$ REFORMAT h s k -> CODE s
forall h s k. Sections h s k => REFORMAT h s k -> CODE s
section_c REFORMAT h s k
rft
, enc_k :: Munch String
enc_k = CODE k -> Munch String
forall a. Code a => CODE a -> Munch String
code_m (CODE k -> Munch String) -> CODE k -> Munch String
forall a b. (a -> b) -> a -> b
$ REFORMAT h s k -> CODE k
forall h s k. Sections h s k => REFORMAT h s k -> CODE k
key_c REFORMAT h s k
rft
}
where
host_c :: Sections h s k => REFORMAT h s k -> CODE h
host_c :: REFORMAT h s k -> CODE h
host_c REFORMAT h s k
_ = CODE h
forall a. CODE a
CODE
section_c :: Sections h s k => REFORMAT h s k -> CODE s
section_c :: REFORMAT h s k -> CODE s
section_c REFORMAT h s k
_ = CODE s
forall a. CODE a
CODE
key_c :: Sections h s k => REFORMAT h s k -> CODE k
key_c :: REFORMAT h s k -> CODE k
key_c REFORMAT h s k
_ = CODE k
forall a. CODE a
CODE
code_m :: Code a => CODE a -> Munch String
code_m :: CODE a -> Munch String
code_m CODE a
c = (Munch String -> Munch String -> Munch String)
-> Munch String -> [Munch String] -> Munch String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Munch String -> Munch String -> Munch String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Munch String
forall (f :: * -> *) a. Alternative f => f a
empty ([Munch String] -> Munch String) -> [Munch String] -> Munch String
forall a b. (a -> b) -> a -> b
$ [ String -> Munch String
munch (String -> Munch String) -> String -> Munch String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Code a => a -> String
encode a
x | a
x<-CODE a -> [a]
forall a. Code a => CODE a -> [a]
bds CODE a
c ]
where
bds :: Code a => CODE a -> [a]
bds :: CODE a -> [a]
bds CODE a
_ = [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]
newtype Munch a = Munch { Munch a -> String -> Maybe (a, String)
_Munch :: String -> Maybe (a,String) }
instance Functor Munch where
fmap :: (a -> b) -> Munch a -> Munch b
fmap a -> b
f Munch a
m = Munch a
m Munch a -> (a -> Munch b) -> Munch b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> b -> Munch b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Munch b) -> b -> Munch b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
instance Applicative Munch where
pure :: a -> Munch a
pure a
x = (String -> Maybe (a, String)) -> Munch a
forall a. (String -> Maybe (a, String)) -> Munch a
Munch ((String -> Maybe (a, String)) -> Munch a)
-> (String -> Maybe (a, String)) -> Munch a
forall a b. (a -> b) -> a -> b
$ \String
s -> (a, String) -> Maybe (a, String)
forall a. a -> Maybe a
Just (a
x,String
s)
<*> :: Munch (a -> b) -> Munch a -> Munch b
(<*>) = Munch (a -> b) -> Munch a -> Munch b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative Munch where
empty :: Munch a
empty = (String -> Maybe (a, String)) -> Munch a
forall a. (String -> Maybe (a, String)) -> Munch a
Munch ((String -> Maybe (a, String)) -> Munch a)
-> (String -> Maybe (a, String)) -> Munch a
forall a b. (a -> b) -> a -> b
$ Maybe (a, String) -> String -> Maybe (a, String)
forall a b. a -> b -> a
const Maybe (a, String)
forall a. Maybe a
Nothing
<|> :: Munch a -> Munch a -> Munch a
(<|>) Munch a
x Munch a
y = (String -> Maybe (a, String)) -> Munch a
forall a. (String -> Maybe (a, String)) -> Munch a
Munch ((String -> Maybe (a, String)) -> Munch a)
-> (String -> Maybe (a, String)) -> Munch a
forall a b. (a -> b) -> a -> b
$ \String
s -> Munch a -> String -> Maybe (a, String)
forall a. Munch a -> String -> Maybe (a, String)
_Munch Munch a
x String
s Maybe (a, String) -> Maybe (a, String) -> Maybe (a, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Munch a -> String -> Maybe (a, String)
forall a. Munch a -> String -> Maybe (a, String)
_Munch Munch a
y String
s
instance Monad Munch where
return :: a -> Munch a
return = a -> Munch a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: Munch a -> (a -> Munch b) -> Munch b
(>>=) Munch a
m a -> Munch b
f = (String -> Maybe (b, String)) -> Munch b
forall a. (String -> Maybe (a, String)) -> Munch a
Munch ((String -> Maybe (b, String)) -> Munch b)
-> (String -> Maybe (b, String)) -> Munch b
forall a b. (a -> b) -> a -> b
$ \String
s -> Munch a -> String -> Maybe (a, String)
forall a. Munch a -> String -> Maybe (a, String)
_Munch Munch a
m String
s Maybe (a, String)
-> ((a, String) -> Maybe (b, String)) -> Maybe (b, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,String
s') -> Munch b -> String -> Maybe (b, String)
forall a. Munch a -> String -> Maybe (a, String)
_Munch (a -> Munch b
f a
x) String
s'
run_munch :: Munch a -> String -> Maybe a
run_munch :: Munch a -> String -> Maybe a
run_munch (Munch String -> Maybe (a, String)
f) String
str = case String -> Maybe (a, String)
f String
str of
Just (a
x,String
"") -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
Maybe (a, String)
_ -> Maybe a
forall a. Maybe a
Nothing
munch1 :: (Char->Bool) -> Munch Char
munch1 :: (Char -> Bool) -> Munch Char
munch1 Char -> Bool
p = (String -> Maybe (Char, String)) -> Munch Char
forall a. (String -> Maybe (a, String)) -> Munch a
Munch ((String -> Maybe (Char, String)) -> Munch Char)
-> (String -> Maybe (Char, String)) -> Munch Char
forall a b. (a -> b) -> a -> b
$ \String
str -> case String
str of
Char
c:String
t | Char -> Bool
p Char
c -> (Char, String) -> Maybe (Char, String)
forall a. a -> Maybe a
Just (Char
c,String
t)
String
_ -> Maybe (Char, String)
forall a. Maybe a
Nothing
munch_ :: String -> Munch ()
munch_ :: String -> Munch ()
munch_ String
s = () -> String -> ()
forall a b. a -> b -> a
const () (String -> ()) -> Munch String -> Munch ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Munch String
munch String
s
munch :: String -> Munch String
munch :: String -> Munch String
munch String
str_p = (String -> Maybe (String, String)) -> Munch String
forall a. (String -> Maybe (a, String)) -> Munch a
Munch ((String -> Maybe (String, String)) -> Munch String)
-> (String -> Maybe (String, String)) -> Munch String
forall a b. (a -> b) -> a -> b
$ \String
str -> case String
str_p String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str of
Bool
True -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
str_p,Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str_p) String
str)
Bool
False -> Maybe (String, String)
forall a. Maybe a
Nothing
key2KeyData :: Key -> Maybe KeyData
key2KeyData :: Key -> Maybe KeyData
key2KeyData Key{Bool
Maybe PublicKey
Maybe PrivateKey
Maybe ClearText
Maybe EnvVar
Maybe Hash
UTCTime
EncrypedCopyMap
Name
Comment
Identity
_key_created_at :: Key -> UTCTime
_key_clear_private :: Key -> Maybe PrivateKey
_key_clear_text :: Key -> Maybe ClearText
_key_secret_copies :: Key -> EncrypedCopyMap
_key_public :: Key -> Maybe PublicKey
_key_hash :: Key -> Maybe Hash
_key_env_var :: Key -> Maybe EnvVar
_key_is_binary :: Key -> Bool
_key_identity :: Key -> Identity
_key_comment :: Key -> Comment
_key_created_at :: UTCTime
_key_clear_private :: Maybe PrivateKey
_key_clear_text :: Maybe ClearText
_key_secret_copies :: EncrypedCopyMap
_key_public :: Maybe PublicKey
_key_hash :: Maybe Hash
_key_env_var :: Maybe EnvVar
_key_is_binary :: Bool
_key_identity :: Identity
_key_comment :: Comment
_key_name :: Name
_key_name :: Key -> Name
..} = ClearText -> KeyData
f (ClearText -> KeyData) -> Maybe ClearText -> Maybe KeyData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ClearText
_key_clear_text
where
f :: ClearText -> KeyData
f (ClearText(Binary ByteString
bs)) =
KeyData :: Identity -> Comment -> ByteString -> KeyData
KeyData
{ kd_identity :: Identity
kd_identity = Identity
_key_identity
, kd_comment :: Comment
kd_comment = Comment
_key_comment
, kd_secret :: ByteString
kd_secret = ByteString
bs
}
name' :: String -> Name
name' :: String -> Name
name' = (Reason -> Name) -> (Name -> Name) -> Either Reason Name -> Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Name
forall a. HasCallStack => String -> a
error(String -> Name) -> (Reason -> String) -> Reason -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Reason -> String
forall a. Show a => a -> String
show) Name -> Name
forall a. a -> a
id (Either Reason Name -> Name)
-> (String -> Either Reason Name) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Reason Name
name