{-# 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 [Char]
s = forall a. [a] -> Maybe a
listToMaybe [ a
k | a
k<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], forall a. Code a => a -> [Char]
encode a
kforall a. Eq a => a -> a -> Bool
==[Char]
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 = forall a b. a -> b -> a
const SectionType
ST_keys
superSections = forall a b. a -> b -> a
const []
keyIsHostIndexed = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
keyIsInSection = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True
getKeyData Maybe h
mb s
s k
k = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall h s k.
Sections h s k =>
[Char] -> k -> IO (KeyDataMode, KeyData)
get_kd forall a b. (a -> b) -> a -> b
$ forall a. Code a => a -> [Char]
encode s
s
getKeyDataWithMode (Just h
h) s
_ = forall h s k.
Sections h s k =>
[Char] -> k -> IO (KeyDataMode, KeyData)
get_kd forall a b. (a -> b) -> a -> b
$ forall a. Code a => a -> [Char]
encode h
h
sectionSettings = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
describeKey k
k = [Char]
"The '" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode k
k forall a. [a] -> [a] -> [a]
++ [Char]
"' key."
describeSection s
s = [Char]
"The '" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode s
s forall a. [a] -> [a] -> [a]
++ [Char]
"' Section."
sectionPWEnvVar = Text -> EnvVar
EnvVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"KEY_pw_" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Code a => a -> [Char]
encode
data SectionType
= ST_top
| ST_signing
| ST_keys
deriving (Int -> SectionType -> [Char] -> [Char]
[SectionType] -> [Char] -> [Char]
SectionType -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [SectionType] -> [Char] -> [Char]
$cshowList :: [SectionType] -> [Char] -> [Char]
show :: SectionType -> [Char]
$cshow :: SectionType -> [Char]
showsPrec :: Int -> SectionType -> [Char] -> [Char]
$cshowsPrec :: Int -> SectionType -> [Char] -> [Char]
Show,SectionType -> SectionType -> Bool
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
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
Ord)
data KeyData =
KeyData
{ KeyData -> Identity
kd_identity :: Identity
, :: Comment
, KeyData -> ByteString
kd_secret :: B.ByteString
}
deriving (Int -> KeyData -> [Char] -> [Char]
[KeyData] -> [Char] -> [Char]
KeyData -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [KeyData] -> [Char] -> [Char]
$cshowList :: [KeyData] -> [Char] -> [Char]
show :: KeyData -> [Char]
$cshow :: KeyData -> [Char]
showsPrec :: Int -> KeyData -> [Char] -> [Char]
$cshowsPrec :: Int -> KeyData -> [Char] -> [Char]
Show,KeyData -> KeyData -> Bool
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
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]
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
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
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
Ord,Int -> KeyDataMode -> [Char] -> [Char]
[KeyDataMode] -> [Char] -> [Char]
KeyDataMode -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [KeyDataMode] -> [Char] -> [Char]
$cshowList :: [KeyDataMode] -> [Char] -> [Char]
show :: KeyDataMode -> [Char]
$cshow :: KeyDataMode -> [Char]
showsPrec :: Int -> KeyDataMode -> [Char] -> [Char]
$cshowsPrec :: Int -> KeyDataMode -> [Char] -> [Char]
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 -> [Char] -> [Char]
[RetrieveDg] -> [Char] -> [Char]
RetrieveDg -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [RetrieveDg] -> [Char] -> [Char]
$cshowList :: [RetrieveDg] -> [Char] -> [Char]
show :: RetrieveDg -> [Char]
$cshow :: RetrieveDg -> [Char]
showsPrec :: Int -> RetrieveDg -> [Char] -> [Char]
$cshowsPrec :: Int -> RetrieveDg -> [Char] -> [Char]
Show,RetrieveDg -> RetrieveDg -> Bool
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
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
Ord)
initialise :: Sections h s k => CtxParams -> KeyPredicate h s k -> IO ()
initialise :: forall h s k.
Sections h s k =>
CtxParams -> KeyPredicate h s k -> IO ()
initialise CtxParams
cp KeyPredicate h s k
kp = do
Settings
stgs <- forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt Bool
opt__sections_fix Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h s k.
Sections h s k =>
KeyPredicate h s k -> Maybe s -> IO Settings
scs KeyPredicate h s k
kp forall a. Maybe a
Nothing
[Char] -> Settings -> IO ()
newKeyStore (CtxParams -> [Char]
the_keystore CtxParams
cp) Settings
stgs
IC
ic <- CtxParams -> IO IC
instanceCtx CtxParams
cp
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall h s k.
Sections h s k =>
KeyPredicate h s k -> IC -> s -> IO ()
mks KeyPredicate h s k
kp IC
ic) [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
forall h s k. Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotate IC
ic KeyPredicate h s k
kp
forall a b. (a -> b) -> [a] -> [b]
map Key -> Name
_key_name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO [Key]
keys IC
ic forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: forall h s k.
Sections h s k =>
KeyPredicate h s k -> Maybe s -> IO Settings
scs = forall a b. a -> b -> a
const 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 :: forall h s k.
Sections h s k =>
KeyPredicate h s k -> IC -> s -> IO ()
mks = forall a b. a -> b -> a
const forall h s k. Sections h s k => IC -> s -> IO ()
mkSection
rotate :: Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotate :: forall h s k. Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotate IC
ic = forall h s k.
Sections h s k =>
IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ IC
ic forall a. Maybe a
Nothing Bool
False
rotateIfChanged :: Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotateIfChanged :: forall h s k. Sections h s k => IC -> KeyPredicate h s k -> IO ()
rotateIfChanged IC
ic = forall h s k.
Sections h s k =>
IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ IC
ic forall a. Maybe a
Nothing Bool
True
rotate_ :: Sections h s k => IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ :: forall h s k.
Sections h s k =>
IC -> Maybe KeyDataMode -> Bool -> KeyPredicate h s k -> IO ()
rotate_ IC
ic Maybe KeyDataMode
mb Bool
ch KeyPredicate h s k
kp = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ 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)<-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' = 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 :: forall h s k. Sections h s k => IC -> h -> k -> IO (Retrieve [Key])
retrieve IC
ic h
h k
k = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat forall {s} {k}. REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (\Name
nm->forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h s k. Sections h s k => REFORMAT h s k -> Name -> IO [Key]
locate_keys forall {s} {k}. REFORMAT h s k
ic' Name
nm) forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => h -> k -> Retrieve Name
keyName h
h k
k
where
ic' :: REFORMAT h s k
ic' = 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 :: forall h s k.
Sections h s k =>
IC -> SECTIONS h s k -> IO ByteString
signKeystore IC
ic SECTIONS h s k
scn = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
B.readFile (CtxParams -> [Char]
the_keystore forall a b. (a -> b) -> a -> b
$ IC -> CtxParams
ic_ctx_params IC
ic) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IC -> Name -> ByteString -> IO ByteString
sign_ IC
ic (forall h s k. Sections h s k => s -> Name
sgn_nme forall a b. (a -> b) -> a -> b
$ 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' = 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 :: forall h s k.
Sections h s k =>
IC -> SECTIONS h s k -> ByteString -> IO Bool
verifyKeystore IC
ic SECTIONS h s k
scn ByteString
sig = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
B.readFile (CtxParams -> [Char]
the_keystore forall a b. (a -> b) -> a -> b
$ IC -> CtxParams
ic_ctx_params IC
ic) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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' = 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 :: forall h s k. KeyPredicate h s k
noKeys Maybe h
_ s
_ k
_ = Bool
False
allKeys :: KeyPredicate h s k
allKeys :: forall h s k. 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 :: forall h s k.
Sections h s k =>
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_keysforall a. [a] -> [a] -> [a]
++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 = [ (forall a. a -> Maybe a
Just h
h ,s
s,k
k) | k
k<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], Just h -> Bool
isp<-[forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k], h
h<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], h -> Bool
isp h
h, let s :: s
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 = [ (forall a. Maybe a
Nothing,s
s,k
k) | k
k<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], Maybe (h -> Bool)
Nothing <-[forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k], s
s<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], 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 :: forall h s k.
Sections h s k =>
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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\h
h->forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (h
hforall a. Eq a => a -> a -> Bool
==) Maybe h
mbh_) Maybe h
mbh
s_ok :: Bool
s_ok = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (s
sforall a. Eq a => a -> a -> Bool
==) Maybe s
mbs
k_ok :: Bool
k_ok = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (k
kforall a. Eq a => a -> a -> Bool
==) Maybe k
mbk
keyHelp :: Sections h s k => Maybe k -> T.Text
keyHelp :: forall h s k. Sections h s k => Maybe k -> Text
keyHelp x :: Maybe k
x@Maybe k
Nothing = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Code a => a -> [Char]
encode) [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` forall a. HasCallStack => Maybe a -> a
fromJust Maybe k
x ]
keyHelp (Just k
k) = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
f forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ (,) (forall a. Code a => a -> [Char]
encode k
k) [Char]
"" ]
, [ (,) [Char]
" hosts:" [Char]
hln | Just [Char]
hln <- [Maybe [Char]
mb_hln] ]
, [ (,) [Char]
" sections:" [Char]
sln | Maybe [Char]
Nothing <- [Maybe [Char]
mb_hln] ]
]) forall a. [a] -> [a] -> [a]
++ [Char]
"" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" "forall a. [a] -> [a] -> [a]
++) ([Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => k -> [Char]
describeKey k
k) forall a. [a] -> [a] -> [a]
++ [[Char]
""]
where
mb_hln :: Maybe [Char]
mb_hln = forall a. Code a => (a -> Bool) -> [Char]
fmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k
sln :: [Char]
sln = forall a. Code a => (a -> Bool) -> [Char]
fmt forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection k
k
f :: ([Char], [Char]) -> [Char]
f = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%-10s %s"
sectionHelp :: Sections h s k => Maybe s -> IO T.Text
sectionHelp :: forall h s k. Sections h s k => Maybe s -> IO Text
sectionHelp x :: Maybe s
x@Maybe s
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Code a => a -> [Char]
encode) [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` forall a. HasCallStack => Maybe a -> a
fromJust Maybe s
x ]
sectionHelp (Just s
s) = do
Settings
stgs <- forall h s k. Sections h s k => Maybe s -> IO Settings
sectionSettings forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just s
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
f forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ (,) (forall a. Code a => a -> [Char]
encode s
s) [Char]
typ ]
, [ (,) [Char]
" p/w env var:" [Char]
env ]
, [ (,) [Char]
" hosts:" [Char]
hln ]
, [ (,) [Char]
" super sections:" [Char]
sln ]
, [ (,) [Char]
" under sections:" [Char]
uln ]
, [ (,) [Char]
" keys:" [Char]
kln ]
, [ (,) [Char]
" settings" [Char]
"" ]
]) forall a. [a] -> [a] -> [a]
++ Settings -> [[Char]]
fmt_s Settings
stgs forall a. [a] -> [a] -> [a]
++ [Char]
"" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" "forall a. [a] -> [a] -> [a]
++) ([Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> [Char]
describeSection s
s) forall a. [a] -> [a] -> [a]
++ [[Char]
""]
where
typ :: [Char]
typ = case forall h s k. Sections h s k => s -> SectionType
sectionType s
s of
SectionType
ST_top -> [Char]
"(top)"
SectionType
ST_signing -> [Char]
"(signing)"
SectionType
ST_keys -> [Char]
"(keys)"
env :: [Char]
env = [Char]
"$" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (EnvVar -> Text
_EnvVar forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> EnvVar
sectionPWEnvVar s
s)
hln :: [Char]
hln = [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub [ forall a. Code a => a -> [Char]
encode h
h | h
h<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], forall h s k. Sections h s k => h -> s
hostDeploySection h
hforall a. Eq a => a -> a -> Bool
==s
s ]
sln :: [Char]
sln = [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Code a => a -> [Char]
encode forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> [s]
superSections s
s
uln :: [Char]
uln = [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Code a => a -> [Char]
encode forall a b. (a -> b) -> a -> b
$ [ s
s_ | s
s_<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], s
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall h s k. Sections h s k => s -> [s]
superSections s
s_ ]
kln :: [Char]
kln = forall a. Code a => (a -> Bool) -> [Char]
fmt forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection s
s
f :: ([Char], [Char]) -> [Char]
f = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%-20s %s"
fmt_s :: Settings -> [[Char]]
fmt_s Settings
stgs = forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" "forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
LBS.unpack forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode forall a b. (a -> b) -> a -> b
$ Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ forall a. HashMap Text a -> KM a
A.intoKM 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 :: forall h s k. Sections h s k => IC -> SECTIONS h s k -> IO Text
secretKeySummary IC
ic SECTIONS h s k
scn = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {h} {s} {k}. Sections h s k => s -> IO Text
f (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 <- [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IC -> Bool -> Name -> IO ByteString
showSecret IC
ic Bool
False forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> Name
passwordName s
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"export ",EnvVar -> Text
_EnvVar forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> EnvVar
sectionPWEnvVar s
s,Text
"=",Text
sec]
ic' :: REFORMAT h s k
ic' = 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 :: forall h s k.
Sections h s k =>
IC -> SECTIONS h s k -> [Char] -> IO Text
publicKeySummary IC
ic SECTIONS h s k
scn [Char]
fp = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ ByteString -> Text
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> Bool -> Name -> IO ByteString
showPublic IC
ic Bool
True (forall h s k. Sections h s k => s -> Name
sgn_nme forall a b. (a -> b) -> a -> b
$ 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 = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"echo '" forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
B.unpack ByteString
b forall a. [a] -> [a] -> [a]
++ [Char]
"' >" forall a. [a] -> [a] -> [a]
++ [Char]
fp forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
ic' :: REFORMAT h s k
ic' = 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 :: forall h s k.
Sections h s k =>
IC -> SECTIONS h s k -> Name -> IO [Key]
locateKeys IC
ic SECTIONS h s k
scn Name
nm = 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' = 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 :: forall h s k. Sections h s k => REFORMAT h s k -> Name -> IO [Key]
locate_keys REFORMAT h s k
ic' Name
nm = forall h s k a. Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat REFORMAT h s k
ic' forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Key -> Name
_key_name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Key -> Bool
yup 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Name
_key_name
isp :: Name -> Bool
isp Name
nm' = [Char]
nm_s forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name -> [Char]
_name Name
nm'
nm_s :: [Char]
nm_s = Name -> [Char]
_name Name
nm
ic :: IC
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 :: forall h s k. Sections h s k => h -> k -> Retrieve Name
keyName h
h k
k = do
Maybe h
mb_h <- case forall h s k. Sections h s k => k -> Maybe (h -> Bool)
keyIsHostIndexed k
k of
Maybe (h -> Bool)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just h -> Bool
hp | h -> Bool
hp h
h -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just h
h
| Bool
otherwise -> forall a b. a -> Either a b
Left RetrieveDg
RDG_no_such_host_key
s
s <- forall h s k. Sections h s k => h -> k -> Retrieve s
keySection h
h k
k
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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_ :: forall h s k. Sections h s k => Maybe h -> s -> k -> Name
keyName_ Maybe h
mb_h s
s k
k = [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ forall a. Code a => a -> [Char]
encode s
s forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode k
k forall a. [a] -> [a] -> [a]
++ [Char]
hst_sfx forall a. [a] -> [a] -> [a]
++ [Char]
"/"
where
hst_sfx :: [Char]
hst_sfx = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\h
h -> [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode h
h) Maybe h
mb_h
key_section :: Sections h s k => h -> k -> s
key_section :: forall h s k. Sections h s k => h -> k -> s
key_section h
h k
k = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {a}. Show a => a -> a
oops forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => h -> k -> Retrieve s
keySection h
h k
k
where
oops :: a -> a
oops a
dg = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"key_section: " forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode h
h forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode k
k forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
dg
keySection :: Sections h s k => h -> k -> Retrieve s
keySection :: forall h s k. Sections h s k => h -> k -> Retrieve s
keySection h
h k
k = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left RetrieveDg
RDG_key_not_reachable) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (forall h s k. Sections h s k => k -> s -> Bool
keyIsInSection k
k) forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> [s]
lower_sections forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => h -> s
hostDeploySection h
h
passwordName :: Sections h s k => s -> Name
passwordName :: forall h s k. Sections h s k => s -> Name
passwordName s
s = [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
"/pw/" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode s
s
fmt :: Code a => (a->Bool) -> String
fmt :: forall a. Code a => (a -> Bool) -> [Char]
fmt a -> Bool
p = [[Char]] -> [Char]
unwords [ forall a. Code a => a -> [Char]
encode a
h | a
h<-[forall a. Bounded a => a
minBound..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' :: 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 = 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
..}) <- 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 forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (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 <- forall a b. (a -> b) -> [a] -> [b]
map Key -> Maybe KeyData
key2KeyData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h s k.
Sections h s k =>
IC -> SECTIONS h s k -> Name -> IO [Key]
locateKeys IC
ic (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
kdforall a. Eq a => a -> a -> Bool
==KeyData
kd' -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Maybe KeyData
Nothing :[Maybe KeyData]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[Maybe KeyData]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False ->
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ok forall a b. (a -> b) -> a -> b
$ do
Name
n_nm <- IC -> Name -> IO Name
unique_nme IC
ic Name
g_nm
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"rotating: " forall a. [a] -> [a] -> [a]
++ Name -> [Char]
_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 forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
kd_secret
Bool
False ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
g_nm :: Name
g_nm = 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 :: forall k h s. k -> SECTIONS h s k
mks = forall a b. a -> b -> a
const forall h s k. SECTIONS h s k
SECTIONS
lower_sections :: Sections h s k => s -> [s]
lower_sections :: forall h s k. Sections h s k => s -> [s]
lower_sections s
s0 =
s
s0 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ s
sforall a. a -> [a] -> [a]
:forall h s k. Sections h s k => s -> [s]
lower_sections s
s | s
s<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], s
s0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall h s k. Sections h s k => s -> [s]
superSections s
s ]
mkSection :: Sections h s k => IC -> s -> IO ()
mkSection :: forall h s k. Sections h s k => IC -> s -> IO ()
mkSection IC
ic s
s = do
forall h s k. Sections h s k => IC -> s -> IO ()
mk_section IC
ic s
s
case forall h s k. Sections h s k => s -> SectionType
sectionType s
s of
SectionType
ST_top -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
SectionType
ST_signing -> forall h s k. Sections h s k => IC -> s -> IO ()
add_signing IC
ic s
s
SectionType
ST_keys -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
mk_section :: Sections h s k => IC -> s -> IO ()
mk_section :: forall h s k. Sections h s k => IC -> s -> IO ()
mk_section IC
ic s
s =
do forall h s k. Sections h s k => IC -> s -> IO ()
add_password IC
ic s
s
forall h s k. Sections h s k => IC -> s -> IO ()
add_save_key IC
ic s
s
forall h s k. Sections h s k => IC -> s -> IO ()
add_trigger IC
ic s
s
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall h s k. Sections h s k => IC -> s -> s -> IO ()
backup_password IC
ic s
s) forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => s -> [s]
superSections s
s
add_signing :: Sections h s k => IC -> s -> IO ()
add_signing :: forall h s k. Sections h s k => IC -> s -> IO ()
add_signing IC
ic s
s = IC -> Name -> Comment -> Identity -> [Safeguard] -> IO ()
createRSAKeyPair IC
ic (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 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"signing key"
pw_sg :: Safeguard
pw_sg = [Name] -> Safeguard
safeguard [forall h s k. Sections h s k => s -> Name
passwordName s
s]
add_password :: Sections h s k => IC -> s -> IO ()
add_password :: forall h s k. Sections h s k => 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 (forall a. a -> Maybe a
Just EnvVar
ev) forall a. Maybe a
Nothing
where
cmt :: Comment
cmt = Text -> Comment
Comment forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"password for " forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode s
s
ide :: Identity
ide = Identity
""
ev :: EnvVar
ev = forall h s k. Sections h s k => s -> EnvVar
sectionPWEnvVar s
s
nm :: Name
nm = 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 :: forall h s k. Sections h s k => 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 = forall h s k. Sections h s k => s -> Name
sve_nme s
s
cmt :: Comment
cmt = Text -> Comment
Comment forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"save key for " forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode s
s
ide :: Identity
ide = Identity
""
pw_sg :: Safeguard
pw_sg = [Name] -> Safeguard
safeguard [forall h s k. Sections h s k => s -> Name
passwordName s
s]
add_trigger :: Sections h s k => IC -> s -> IO ()
add_trigger :: forall h s k. Sections h s k => IC -> s -> IO ()
add_trigger IC
ic s
s = do
Settings
stgs <- (forall h s k. Sections h s k => s -> Settings
bu_settings s
s forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h s k. Sections h s k => Maybe s -> IO Settings
sectionSettings (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 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Code a => a -> [Char]
encode s
s
pat :: Pattern
pat = forall h s k. Sections h s k => s -> Pattern
scn_pattern s
s
bu_settings :: Sections h s k => s -> Settings
bu_settings :: forall h s k. Sections h s k => s -> Settings
bu_settings s
s = HashMap Text Value -> Settings
Settings forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
[ (Text
"backup.keys"
, Array -> Value
A.Array forall a b. (a -> b) -> a -> b
$ forall a. a -> Vector a
V.singleton forall a b. (a -> b) -> a -> b
$ Text -> Value
A.String forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Name -> [Char]
_name forall a b. (a -> b) -> a -> b
$ 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 :: forall h s k. Sections h s k => SECTIONS h s k -> s
signing_key SECTIONS h s k
_ = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
oops forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [ s
s_ | s
s_<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], forall h s k. Sections h s k => s -> SectionType
sectionType s
s_ forall a. Eq a => a -> a -> Bool
== SectionType
ST_signing ]
where
oops :: a
oops = forall a. HasCallStack => [Char] -> a
error [Char]
"signing_key: there is no signing key!"
sections :: Sections h s k => SECTIONS h s k -> [s]
sections :: forall h s k. Sections h s k => SECTIONS h s k -> [s]
sections SECTIONS h s k
_ = [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
backup_password :: Sections h s k => IC -> s -> s -> IO ()
backup_password :: forall h s k. Sections h s k => IC -> s -> s -> IO ()
backup_password IC
ic s
s s
sv_s = IC -> Name -> Safeguard -> IO ()
secureKey IC
ic (forall h s k. Sections h s k => s -> Name
passwordName s
s) forall a b. (a -> b) -> a -> b
$ [Name] -> Safeguard
safeguard [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 :: forall h s k. Sections h s k => s -> Name
sgn_nme s
s = [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ forall a. Code a => a -> [Char]
encode s
s forall a. [a] -> [a] -> [a]
++ [Char]
"/keystore_signing_key"
sve_nme :: Sections h s k => s -> Name
sve_nme :: forall h s k. Sections h s k => s -> Name
sve_nme s
s = [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
"/save/" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode s
s
scn_pattern :: Sections h s k => s -> Pattern
scn_pattern :: forall h s k. Sections h s k => s -> Pattern
scn_pattern s
s = [Char] -> Pattern
pattern forall a b. (a -> b) -> a -> b
$ [Char]
"^" forall a. [a] -> [a] -> [a]
++ forall a. Code a => a -> [Char]
encode s
s forall a. [a] -> [a] -> [a]
++ [Char]
"/.*"
unique_nme :: IC -> Name -> IO Name
unique_nme :: IC -> Name -> IO Name
unique_nme IC
ic Name
nm =
do [Name]
nms <- forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Key -> Name
_key_name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO [Key]
keys IC
ic
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Name] -> Name -> Name
unique_nme' [Name]
nms Name
nm
where
isp :: Name -> Bool
isp Name
nm' = Name -> [Char]
_name Name
nm forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name -> [Char]
_name Name
nm'
unique_nme' :: [Name] -> Name -> Name
unique_nme' :: [Name] -> Name -> Name
unique_nme' [Name]
nms Name
nm0 = forall a. HasCallStack => [Char] -> [a] -> a
headNote [Char]
"unique_name'" [Name]
c_nms
where
c_nms :: [Name]
c_nms = [ Name
nm | Int
i<-[forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
nmsforall a. Num a => a -> a -> a
+Int
1..], let nm :: Name
nm=Int -> Name -> Name
nname Int
i Name
nm0, Name
nm 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_ = [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ Name -> [Char]
_name Name
nm_ forall a. [a] -> [a] -> [a]
++ forall r. PrintfType r => [Char] -> r
printf [Char]
"%03d" Int
i
the_keystore :: CtxParams -> FilePath
the_keystore :: CtxParams -> [Char]
the_keystore = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"keystore.json" forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtxParams -> Maybe [Char]
cp_store
get_kd :: Sections h s k => String -> k -> IO (KeyDataMode,KeyData)
get_kd :: forall h s k.
Sections h s k =>
[Char] -> k -> IO (KeyDataMode, KeyData)
get_kd [Char]
sd k
k = do
ByteString
ide <- [Char] -> IO ByteString
B.readFile forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
fp [Char]
"_id"
ByteString
cmt <- [Char] -> IO ByteString
B.readFile forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
fp [Char]
"_cmt"
ByteString
sec <- [Char] -> IO ByteString
B.readFile forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
fp [Char]
""
forall (m :: * -> *) a. Monad m => a -> m a
return
( KeyDataMode
KDM_static
, KeyData
{ kd_identity :: Identity
kd_identity = Text -> Identity
Identity forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
B.unpack ByteString
ide
, kd_comment :: Comment
kd_comment = Text -> Comment
Comment forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
B.unpack ByteString
cmt
, kd_secret :: ByteString
kd_secret = ByteString
sec
}
)
where
fp :: [Char] -> [Char]
fp [Char]
sfx = [Char]
sd [Char] -> [Char] -> [Char]
</> forall a. Code a => a -> [Char]
encode k
k forall a. [a] -> [a] -> [a]
++ [Char]
sfx
reformat :: Sections h s k => REFORMAT h s k -> IO a -> IO a
reformat :: forall h s k a. Sections h s k => 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 (forall h s k. Sections h s k => REFORMAT h s k -> Encoding
encoding REFORMAT h s k
rft) IC
ic forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
p
data REFORMAT h s k = REFORMAT { forall h s k. 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 :: forall h s k. SECTIONS h s k -> IC -> REFORMAT h s k
scn_RFT SECTIONS h s k
_ IC
ic = forall h s k. IC -> REFORMAT h s k
REFORMAT IC
ic
kp_RFT :: forall h s k. KeyPredicate h s k -> IC -> REFORMAT h s k
kp_RFT KeyPredicate h s k
_ IC
ic = forall h s k. IC -> REFORMAT h s k
REFORMAT IC
ic
h_RFT :: forall h s k. h -> IC -> REFORMAT h s k
h_RFT h
_ IC
ic = 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 forall a b. (a -> b) -> a -> b
$
State
st { st_keystore :: KeyStore
st_keystore = Encoding -> KeyStore -> KeyStore
reformat_keystore Encoding
enc 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 forall a. Opt a -> Settings -> a
getSettingsOpt Opt Bool
opt__sections_fix forall a b. (a -> b) -> a -> b
$ Configuration -> Settings
_cfg_settings forall a b. (a -> b) -> a -> b
$ KeyStore -> Configuration
_ks_config KeyStore
ks of
Bool
True -> KeyStore
ks
Bool
False -> forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' KeyStore Configuration
ks_config (Encoding -> Configuration -> Configuration
reformat_config Encoding
enc) forall a b. (a -> b) -> a -> b
$
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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 =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Configuration Settings
cfg_settings (forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt Bool
opt__sections_fix Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Configuration Settings
cfg_settings (Encoding -> Settings -> Settings
reformat_settings Encoding
enc) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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 = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a -> b) -> a -> b
$
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Trigger Pattern
trg_pattern (Encoding -> Pattern -> Pattern
reformat_pattern Encoding
enc) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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 forall a. Opt a -> Settings -> Maybe a
getSettingsOpt' Opt [Name]
opt__backup_keys Settings
stgs of
Maybe [Name]
Nothing -> Settings
stgs
Just [Name]
nms -> forall a. Opt a -> a -> Settings -> Settings
setSettingsOpt Opt [Name]
opt__backup_keys (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
oops forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Munch a -> [Char] -> Maybe a
run_munch (Encoding -> Munch Pattern
m_pattern Encoding
enc) forall a b. (a -> b) -> a -> b
$ Pattern -> [Char]
_pat_string Pattern
pat
where
oops :: a
oops = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"reformat_pattern: bad pattern format: " forall a. [a] -> [a] -> [a]
++ Pattern -> [Char]
_pat_string Pattern
pat
reformat_key_map :: Encoding -> KeyMap -> KeyMap
reformat_key_map :: Encoding -> KeyMap -> KeyMap
reformat_key_map Encoding
enc KeyMap
km = 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)<-forall k a. Map k a -> [(k, a)]
Map.toList KeyMap
km ]
where
r_ky :: Key -> Key
r_ky =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Key Name
key_name (Encoding -> Name -> Name
reformat_name Encoding
enc) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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 = 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)<-forall k a. Map k a -> [(k, a)]
Map.toList EncrypedCopyMap
ecm ]
where
r_ec :: EncrypedCopy -> EncrypedCopy
r_ec = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Encoding -> Name -> Name
reformat_name Encoding
enc) 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
oops forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Munch a -> [Char] -> Maybe a
run_munch (Encoding -> Munch Name
m_name Encoding
enc) forall a b. (a -> b) -> a -> b
$ Name -> [Char]
_name Name
nm
where
oops :: a
oops = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"reformat_name: bad name format: " forall a. [a] -> [a] -> [a]
++ Name -> [Char]
_name Name
nm
m_pattern :: Encoding -> Munch Pattern
m_pattern :: Encoding -> Munch Pattern
m_pattern Encoding
enc = do
[Char] -> Munch ()
munch_ [Char]
"^"
[Char]
s <- Encoding -> Munch [Char]
enc_s Encoding
enc
[Char] -> Munch ()
munch_ [Char]
"_.*"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"^" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"/.*"
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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> Munch Name
m_pw Encoding
enc 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
[Char] -> Munch ()
munch_ [Char]
"save_"
[Char]
s <- Encoding -> Munch [Char]
enc_s Encoding
enc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
"/save/" forall a. [a] -> [a] -> [a]
++ [Char]
s
m_pw :: Encoding -> Munch Name
m_pw Encoding
enc = do
[Char] -> Munch ()
munch_ [Char]
"pw_"
[Char]
s <- Encoding -> Munch [Char]
enc_s Encoding
enc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
"/pw/" forall a. [a] -> [a] -> [a]
++ [Char]
s
m_section :: Encoding -> Munch Name
m_section Encoding
enc = do
[Char]
s <- Encoding -> Munch [Char]
enc_s Encoding
enc
Encoding -> [Char] -> Munch Name
m_section_signing Encoding
enc [Char]
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> [Char] -> Munch Name
m_section_key Encoding
enc [Char]
s
m_section_key, m_section_signing :: Encoding -> String -> Munch Name
m_section_signing :: Encoding -> [Char] -> Munch Name
m_section_signing Encoding
_ [Char]
s = do
[Char] -> Munch ()
munch_ [Char]
"_keystore_signing_key"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"/keystore_signing_key"
m_section_key :: Encoding -> [Char] -> Munch Name
m_section_key Encoding
enc [Char]
s = do
[Char] -> Munch ()
munch_ [Char]
"_"
[Char]
k <- Encoding -> Munch [Char]
enc_k Encoding
enc
Encoding -> [Char] -> [Char] -> Munch Name
m_section_key_host Encoding
enc [Char]
s [Char]
k forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoding -> [Char] -> [Char] -> Munch Name
m_section_key_vrn Encoding
enc [Char]
s [Char]
k
m_section_key_vrn, m_section_key_host :: Encoding -> String -> String -> Munch Name
m_section_key_vrn :: Encoding -> [Char] -> [Char] -> Munch Name
m_section_key_vrn Encoding
_ [Char]
s [Char]
k = do
[Char] -> Munch ()
munch_ [Char]
"_"
[Char]
v <- Munch [Char]
munch_vrn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
s forall a. [a] -> [a] -> [a]
++[Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
v
m_section_key_host :: Encoding -> [Char] -> [Char] -> Munch Name
m_section_key_host Encoding
enc [Char]
s [Char]
k = do
[Char] -> Munch ()
munch_ [Char]
"_"
[Char]
h <- Encoding -> Munch [Char]
enc_h Encoding
enc
[Char] -> Munch ()
munch_ [Char]
"_"
[Char]
v <- Munch [Char]
munch_vrn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Name
name' forall a b. (a -> b) -> a -> b
$ [Char]
s forall a. [a] -> [a] -> [a]
++[Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
h forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
v
munch_vrn :: Munch String
munch_vrn :: Munch [Char]
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
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c1,Char
c2,Char
c3]
data Encoding =
Encoding
{ Encoding -> Munch [Char]
enc_h, Encoding -> Munch [Char]
enc_s, Encoding -> Munch [Char]
enc_k :: Munch String
}
encoding :: Sections h s k => REFORMAT h s k -> Encoding
encoding :: forall h s k. Sections h s k => REFORMAT h s k -> Encoding
encoding REFORMAT h s k
rft =
Encoding
{ enc_h :: Munch [Char]
enc_h = forall a. Code a => CODE a -> Munch [Char]
code_m forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => REFORMAT h s k -> CODE h
host_c REFORMAT h s k
rft
, enc_s :: Munch [Char]
enc_s = forall a. Code a => CODE a -> Munch [Char]
code_m forall a b. (a -> b) -> a -> b
$ forall h s k. Sections h s k => REFORMAT h s k -> CODE s
section_c REFORMAT h s k
rft
, enc_k :: Munch [Char]
enc_k = forall a. Code a => CODE a -> Munch [Char]
code_m forall a b. (a -> b) -> a -> b
$ 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 :: forall h s k. Sections h s k => REFORMAT h s k -> CODE h
host_c REFORMAT h s k
_ = forall a. CODE a
CODE
section_c :: Sections h s k => REFORMAT h s k -> CODE s
section_c :: forall h s k. Sections h s k => REFORMAT h s k -> CODE s
section_c REFORMAT h s k
_ = forall a. CODE a
CODE
key_c :: Sections h s k => REFORMAT h s k -> CODE k
key_c :: forall h s k. Sections h s k => REFORMAT h s k -> CODE k
key_c REFORMAT h s k
_ = forall a. CODE a
CODE
code_m :: Code a => CODE a -> Munch String
code_m :: forall a. Code a => CODE a -> Munch [Char]
code_m CODE a
c = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty forall a b. (a -> b) -> a -> b
$ [ [Char] -> Munch [Char]
munch forall a b. (a -> b) -> a -> b
$ forall a. Code a => a -> [Char]
encode a
x | a
x<-forall a. Code a => CODE a -> [a]
bds CODE a
c ]
where
bds :: Code a => CODE a -> [a]
bds :: forall a. Code a => CODE a -> [a]
bds CODE a
_ = [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
newtype Munch a = Munch { forall a. Munch a -> [Char] -> Maybe (a, [Char])
_Munch :: String -> Maybe (a,String) }
instance Functor Munch where
fmap :: forall a b. (a -> b) -> Munch a -> Munch b
fmap a -> b
f Munch a
m = Munch a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
instance Applicative Munch where
pure :: forall a. a -> Munch a
pure a
x = forall a. ([Char] -> Maybe (a, [Char])) -> Munch a
Munch forall a b. (a -> b) -> a -> b
$ \[Char]
s -> forall a. a -> Maybe a
Just (a
x,[Char]
s)
<*> :: forall a 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 :: forall a. Munch a
empty = forall a. ([Char] -> Maybe (a, [Char])) -> Munch a
Munch forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Maybe a
Nothing
<|> :: forall a. Munch a -> Munch a -> Munch a
(<|>) Munch a
x Munch a
y = forall a. ([Char] -> Maybe (a, [Char])) -> Munch a
Munch forall a b. (a -> b) -> a -> b
$ \[Char]
s -> forall a. Munch a -> [Char] -> Maybe (a, [Char])
_Munch Munch a
x [Char]
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Munch a -> [Char] -> Maybe (a, [Char])
_Munch Munch a
y [Char]
s
instance Monad Munch where
return :: forall a. a -> Munch a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: forall a b. Munch a -> (a -> Munch b) -> Munch b
(>>=) Munch a
m a -> Munch b
f = forall a. ([Char] -> Maybe (a, [Char])) -> Munch a
Munch forall a b. (a -> b) -> a -> b
$ \[Char]
s -> forall a. Munch a -> [Char] -> Maybe (a, [Char])
_Munch Munch a
m [Char]
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,[Char]
s') -> forall a. Munch a -> [Char] -> Maybe (a, [Char])
_Munch (a -> Munch b
f a
x) [Char]
s'
run_munch :: Munch a -> String -> Maybe a
run_munch :: forall a. Munch a -> [Char] -> Maybe a
run_munch (Munch [Char] -> Maybe (a, [Char])
f) [Char]
str = case [Char] -> Maybe (a, [Char])
f [Char]
str of
Just (a
x,[Char]
"") -> forall a. a -> Maybe a
Just a
x
Maybe (a, [Char])
_ -> forall a. Maybe a
Nothing
munch1 :: (Char->Bool) -> Munch Char
munch1 :: (Char -> Bool) -> Munch Char
munch1 Char -> Bool
p = forall a. ([Char] -> Maybe (a, [Char])) -> Munch a
Munch forall a b. (a -> b) -> a -> b
$ \[Char]
str -> case [Char]
str of
Char
c:[Char]
t | Char -> Bool
p Char
c -> forall a. a -> Maybe a
Just (Char
c,[Char]
t)
[Char]
_ -> forall a. Maybe a
Nothing
munch_ :: String -> Munch ()
munch_ :: [Char] -> Munch ()
munch_ [Char]
s = forall a b. a -> b -> a
const () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Munch [Char]
munch [Char]
s
munch :: String -> Munch String
munch :: [Char] -> Munch [Char]
munch [Char]
str_p = forall a. ([Char] -> Maybe (a, [Char])) -> Munch a
Munch forall a b. (a -> b) -> a -> b
$ \[Char]
str -> case [Char]
str_p forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
str of
Bool
True -> forall a. a -> Maybe a
Just ([Char]
str_p,forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str_p) [Char]
str)
Bool
False -> 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 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
{ 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' :: [Char] -> Name
name' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
errorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> [Char]
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> E Name
name