{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.KeyStore.IO
( readSettings
, CtxParams(..)
, IC(..)
, module Data.KeyStore.Types
, module Data.KeyStore.KS.KS
, keyStoreBytes
, keyStoreFromBytes
, settingsFromBytes
, defaultSettingsFilePath
, settingsFilePath
, defaultKeyStoreFilePath
, defaultCtxParams
, instanceCtx
, instanceCtx_
, newKeyStore
, store
, listSettings
, settings
, updateSettings
, listTriggers
, triggers
, addTrigger
, addTrigger'
, rmvTrigger
, createRSAKeyPair
, createKey
, adjustKey
, rememberKey
, rememberKey_
, secureKey
, loadKey
, showIdentity
, showComment
, showDate
, showHash
, showHashComment
, showHashSalt
, showPublic
, showSecret
, keys
, list
, keyInfo
, deleteKeys
, encrypt
, encrypt_
, encrypt__
, decrypt
, decrypt_
, decrypt__
, sign
, sign_
, verify
, verify_
, run
, getKeystore
, getState
, getCtxState
, putCtxState
) where
import Data.KeyStore.IO.IC
import Data.KeyStore.KS
import Data.KeyStore.KS.KS
import Data.KeyStore.Types
import Data.KeyStore.Types.AesonCompat
import Data.API.Types
import Data.IORef
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Base64 as B64
import qualified Data.Map as Map
import Data.Time
import Text.Printf
import qualified Control.Exception as X
import qualified Control.Lens as L
import Control.Monad
import System.IO
#if MIN_VERSION_time(1,5,0)
#else
import System.Locale (defaultTimeLocale)
#endif
newKeyStore :: FilePath -> Settings -> IO ()
newKeyStore :: String -> Settings -> IO ()
newKeyStore String
str_fp Settings
stgs =
do Either SomeException ByteString
ei <- forall e a. Exception e => IO a -> IO (Either e a)
X.try forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile String
str_fp :: IO (Either X.SomeException B.ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (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 b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a
errorIO String
"keystore file exists") Either SomeException ByteString
ei
CPRNG
g <- IO CPRNG
newGenerator
let state :: State
state =
State
{ st_keystore :: KeyStore
st_keystore = Configuration -> KeyStore
emptyKeyStore forall a b. (a -> b) -> a -> b
$ Settings -> Configuration
defaultConfiguration Settings
stgs
, st_cprng :: CPRNG
st_cprng = CPRNG
g
}
String -> ByteString -> IO ()
LBS.writeFile String
str_fp forall a b. (a -> b) -> a -> b
$ KeyStore -> ByteString
keyStoreBytes forall a b. (a -> b) -> a -> b
$ State -> KeyStore
st_keystore State
state
instanceCtx :: CtxParams -> IO IC
instanceCtx :: CtxParams -> IO IC
instanceCtx CtxParams
cp =
do (Ctx, State)
ctx_st <- IC -> IO (Ctx, State)
getCtxState forall a b. (a -> b) -> a -> b
$ CtxParams -> IC
instanceCtx_ CtxParams
cp
CtxParams -> Maybe (IORef (Ctx, State)) -> IC
IC CtxParams
cp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef (Ctx, State)
ctx_st
instanceCtx_ :: CtxParams -> IC
instanceCtx_ :: CtxParams -> IC
instanceCtx_ CtxParams
cp = CtxParams -> Maybe (IORef (Ctx, State)) -> IC
IC CtxParams
cp forall a. Maybe a
Nothing
store :: IC -> IO FilePath
store :: IC -> IO String
store IC
ic = forall a. IC -> KS a -> IO a
run IC
ic KS String
storeKS
listSettings :: IC -> IO ()
listSettings :: IC -> IO ()
listSettings IC
ic = IC -> IO Settings
settings IC
ic forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ()
LBS.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> HashMap Text Value
_Settings
settings :: IC -> IO Settings
settings :: IC -> IO Settings
settings IC
ic = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Configuration -> Settings
_cfg_settings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KS Configuration
getConfig
updateSettings :: IC -> FilePath -> IO ()
updateSettings :: IC -> String -> IO ()
updateSettings IC
ic String
fp =
do ByteString
bs <- String -> IO ByteString
LBS.readFile String
fp
Settings
stgs <- forall a. E a -> IO a
e2io forall a b. (a -> b) -> a -> b
$ ByteString -> E Settings
settingsFromBytes ByteString
bs
forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ (Configuration -> Configuration) -> KS ()
modConfig forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' Configuration Settings
cfg_settings forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Settings
stgs
listTriggers :: IC -> IO ()
listTriggers :: IC -> IO ()
listTriggers IC
ic = IC -> IO [Trigger]
triggers IC
ic forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PrintfType t => Trigger -> t
fmt
where
fmt :: Trigger -> t
fmt Trigger{Settings
Pattern
TriggerID
_trg_settings :: Trigger -> Settings
_trg_pattern :: Trigger -> Pattern
_trg_id :: Trigger -> TriggerID
_trg_settings :: Settings
_trg_pattern :: Pattern
_trg_id :: TriggerID
..} = forall r. PrintfType r => String -> r
printf String
"%-12s : %12s => %s" String
id_s String
pat_s String
stgs_s
where
id_s :: String
id_s = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ TriggerID -> Text
_TriggerID TriggerID
_trg_id
pat_s :: String
pat_s = Pattern -> String
_pat_string Pattern
_trg_pattern
stgs_s :: String
stgs_s = ByteString -> String
LBS.unpack forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall a. HashMap Text a -> KM a
intoKM forall a b. (a -> b) -> a -> b
$ Settings -> HashMap Text Value
_Settings Settings
_trg_settings
triggers :: IC -> IO [Trigger]
triggers :: IC -> IO [Trigger]
triggers IC
ic = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> TriggerMap
_cfg_triggers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KS Configuration
getConfig
addTrigger :: IC -> TriggerID -> Pattern -> FilePath -> IO ()
addTrigger :: IC -> TriggerID -> Pattern -> String -> IO ()
addTrigger IC
ic TriggerID
tid Pattern
pat String
fp =
do ByteString
bs <- String -> IO ByteString
LBS.readFile String
fp
Settings
stgs <- forall a. E a -> IO a
e2io forall a b. (a -> b) -> a -> b
$ ByteString -> E Settings
settingsFromBytes ByteString
bs
IC -> TriggerID -> Pattern -> Settings -> IO ()
addTrigger' IC
ic TriggerID
tid Pattern
pat Settings
stgs
addTrigger' :: IC -> TriggerID -> Pattern -> Settings -> IO ()
addTrigger' :: IC -> TriggerID -> Pattern -> Settings -> IO ()
addTrigger' IC
ic TriggerID
tid Pattern
pat Settings
stgs =
forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ (Configuration -> Configuration) -> KS ()
modConfig forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' Configuration TriggerMap
cfg_triggers forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TriggerID
tid forall a b. (a -> b) -> a -> b
$ TriggerID -> Pattern -> Settings -> Trigger
Trigger TriggerID
tid Pattern
pat Settings
stgs
rmvTrigger :: IC -> TriggerID -> IO ()
rmvTrigger :: IC -> TriggerID -> IO ()
rmvTrigger IC
ic TriggerID
tid = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ (Configuration -> Configuration) -> KS ()
modConfig forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' Configuration TriggerMap
cfg_triggers forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TriggerID
tid
createRSAKeyPair :: IC -> Name -> Comment -> Identity -> [Safeguard] -> IO ()
createRSAKeyPair :: IC -> Name -> Comment -> Identity -> [Safeguard] -> IO ()
createRSAKeyPair IC
ic Name
nm Comment
cmt Identity
ide [Safeguard]
sgs = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> Comment -> Identity -> [Safeguard] -> KS ()
createRSAKeyPairKS Name
nm Comment
cmt Identity
ide [Safeguard]
sgs
createKey :: IC
-> Name
-> Comment
-> Identity
-> Maybe EnvVar
-> Maybe B.ByteString
-> IO ()
createKey :: IC
-> Name
-> Comment
-> Identity
-> Maybe EnvVar
-> Maybe ByteString
-> IO ()
createKey IC
ic Name
nm Comment
cmt Identity
ide Maybe EnvVar
mb_ev Maybe ByteString
mb_bs =
forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name
-> Comment -> Identity -> Maybe EnvVar -> Maybe ClearText -> KS ()
createKeyKS Name
nm Comment
cmt Identity
ide Maybe EnvVar
mb_ev (Binary -> ClearText
ClearText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mb_bs)
adjustKey :: IC -> Name -> (Key->Key) -> IO ()
adjustKey :: IC -> Name -> (Key -> Key) -> IO ()
adjustKey IC
ic Name
nm Key -> Key
adj = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> (Key -> Key) -> KS ()
adjustKeyKS Name
nm Key -> Key
adj
rememberKey :: IC -> Name -> FilePath -> IO ()
rememberKey :: IC -> Name -> String -> IO ()
rememberKey IC
ic Name
nm String
fp = String -> IO ByteString
B.readFile String
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IC -> Name -> ByteString -> IO ()
rememberKey_ IC
ic Name
nm
rememberKey_ :: IC -> Name -> B.ByteString -> IO ()
rememberKey_ :: IC -> Name -> ByteString -> IO ()
rememberKey_ IC
ic Name
nm ByteString
bs = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> ClearText -> KS ()
rememberKeyKS Name
nm forall a b. (a -> b) -> a -> b
$ Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
bs
secureKey :: IC -> Name -> Safeguard -> IO ()
secureKey :: IC -> Name -> Safeguard -> IO ()
secureKey IC
ic Name
nm Safeguard
nms = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> Safeguard -> KS ()
secureKeyKS Name
nm Safeguard
nms
loadKey :: IC -> Name -> IO Key
loadKey :: IC -> Name -> IO Key
loadKey IC
ic Name
nm = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> KS Key
loadKeyKS Name
nm
showIdentity :: IC -> Bool -> Name -> IO B.ByteString
showIdentity :: IC -> Bool -> Name -> IO ByteString
showIdentity IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> ByteString)
-> Bool
-> Name
-> IO ByteString
show_it' IC
ic String
"identity" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Identity
_key_identity) (String -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity -> Text
_Identity)
showComment :: IC -> Bool -> Name -> IO B.ByteString
IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> ByteString)
-> Bool
-> Name
-> IO ByteString
show_it' IC
ic String
"comment" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Comment
_key_comment) (String -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> Text
_Comment )
showDate :: IC -> Bool -> Name -> IO B.ByteString
showDate :: IC -> Bool -> Name -> IO ByteString
showDate IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> ByteString)
-> Bool
-> Name
-> IO ByteString
show_it' IC
ic String
"date" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> UTCTime
_key_created_at) (String -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt)
where
fmt :: String
fmt = String
"%F-%TZ"
showHash :: IC -> Bool -> Name -> IO B.ByteString
showHash :: IC -> Bool -> Name -> IO ByteString
showHash IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> Binary)
-> Bool
-> Name
-> IO ByteString
show_it IC
ic String
"hash" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash -> HashData
_hash_hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Hash
_key_hash) HashData -> Binary
_HashData
showHashComment :: IC -> Bool -> Name -> IO B.ByteString
IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> ByteString)
-> Bool
-> Name
-> IO ByteString
show_it' IC
ic String
"hash" Key -> Maybe Hash
_key_hash Hash -> ByteString
cmt
where
cmt :: Hash -> ByteString
cmt = String -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> Text
_Comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashDescription -> Comment
_hashd_comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> HashDescription
_hash_description
showHashSalt :: IC -> Bool -> Name -> IO B.ByteString
showHashSalt :: IC -> Bool -> Name -> IO ByteString
showHashSalt IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> Binary)
-> Bool
-> Name
-> IO ByteString
show_it IC
ic String
"hash" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashDescription -> Salt
_hashd_salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> HashDescription
_hash_description) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Hash
_key_hash) Salt -> Binary
_Salt
showPublic :: IC -> Bool -> Name -> IO B.ByteString
showPublic :: IC -> Bool -> Name -> IO ByteString
showPublic IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> Binary)
-> Bool
-> Name
-> IO ByteString
show_it IC
ic String
"public" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> ClearText
encodePublicKeyDER forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe PublicKey
_key_public) ClearText -> Binary
_ClearText
showSecret :: IC -> Bool -> Name -> IO B.ByteString
showSecret :: IC -> Bool -> Name -> IO ByteString
showSecret IC
ic = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> Binary)
-> Bool
-> Name
-> IO ByteString
show_it IC
ic String
"secret" Key -> Maybe ClearText
_key_clear_text ClearText -> Binary
_ClearText
show_it :: IC
-> String
-> (Key->Maybe a)
-> (a->Binary)
-> Bool
-> Name
-> IO B.ByteString
show_it :: forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> Binary)
-> Bool
-> Name
-> IO ByteString
show_it IC
ic String
lbl Key -> Maybe a
prj_1 a -> Binary
prj_2 Bool
aa Name
nm = forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> ByteString)
-> Bool
-> Name
-> IO ByteString
show_it' IC
ic String
lbl Key -> Maybe a
prj_1 (Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Binary
prj_2) Bool
aa Name
nm
show_it' :: IC
-> String
-> (Key->Maybe a)
-> (a->B.ByteString)
-> Bool
-> Name
-> IO B.ByteString
show_it' :: forall a.
IC
-> String
-> (Key -> Maybe a)
-> (a -> ByteString)
-> Bool
-> Name
-> IO ByteString
show_it' IC
ic String
lbl Key -> Maybe a
prj_1 a -> ByteString
prj_2 Bool
aa Name
nm =
do Key
key <- IC -> Name -> IO Key
loadKey IC
ic Name
nm
case a -> ByteString
prj_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Maybe a
prj_1 Key
key of
Maybe ByteString
Nothing -> forall a. String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s: %s not present" (Name -> String
_name Name
nm) String
lbl
Just ByteString
bs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
armr ByteString
bs
where
armr :: ByteString -> ByteString
armr = if Bool
aa then ByteString -> ByteString
B64.encode else forall a. a -> a
id
list :: IC -> IO ()
list :: IC -> IO ()
list IC
ic = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ KS ()
listKS
keyInfo :: IC -> Name -> IO ()
keyInfo :: IC -> Name -> IO ()
keyInfo IC
ic Name
nm = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> KS ()
keyInfoKS Name
nm
keys :: IC -> IO [Key]
keys :: IC -> IO [Key]
keys IC
ic = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyStore -> KeyMap
_ks_keymap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO KeyStore
getKeystore IC
ic
deleteKeys :: IC -> [Name] -> IO ()
deleteKeys :: IC -> [Name] -> IO ()
deleteKeys IC
ic [Name]
nms = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ [Name] -> KS ()
deleteKeysKS [Name]
nms
encrypt :: IC -> Name -> FilePath -> FilePath -> IO ()
encrypt :: IC -> Name -> String -> String -> IO ()
encrypt IC
ic Name
nm String
s_fp String
d_fp =
do ByteString
bs <- String -> IO ByteString
B.readFile String
s_fp
ByteString
bs' <- IC -> Name -> ByteString -> IO ByteString
encrypt_ IC
ic Name
nm ByteString
bs
String -> ByteString -> IO ()
B.writeFile String
d_fp ByteString
bs'
encrypt_ :: IC -> Name -> B.ByteString -> IO B.ByteString
encrypt_ :: IC -> Name -> ByteString -> IO ByteString
encrypt_ IC
ic Name
nm ByteString
bs = Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncryptionPacket -> Binary
_EncryptionPacket forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> ClearText -> KS EncryptionPacket
encryptWithRSAKeyKS Name
nm forall a b. (a -> b) -> a -> b
$ Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
bs)
encrypt__ :: IC -> Name -> B.ByteString -> IO RSASecretData
encrypt__ :: IC -> Name -> ByteString -> IO RSASecretData
encrypt__ IC
ic Name
nm ByteString
bs = forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> ClearText -> KS RSASecretData
encryptWithRSAKeyKS_ Name
nm forall a b. (a -> b) -> a -> b
$ Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
bs
decrypt :: IC -> FilePath -> FilePath -> IO ()
decrypt :: IC -> String -> String -> IO ()
decrypt IC
ic String
s_fp String
d_fp =
do ByteString
bs <- String -> IO ByteString
B.readFile String
s_fp
ByteString
bs' <- IC -> ByteString -> IO ByteString
decrypt_ IC
ic ByteString
bs
String -> ByteString -> IO ()
B.writeFile String
d_fp ByteString
bs'
decrypt_ :: IC -> B.ByteString -> IO B.ByteString
decrypt_ :: IC -> ByteString -> IO ByteString
decrypt_ IC
ic ByteString
bs = Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClearText -> Binary
_ClearText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ EncryptionPacket -> KS ClearText
decryptWithRSAKeyKS forall a b. (a -> b) -> a -> b
$ Binary -> EncryptionPacket
EncryptionPacket forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
bs)
decrypt__ :: IC -> Name -> RSASecretData -> IO B.ByteString
decrypt__ :: IC -> Name -> RSASecretData -> IO ByteString
decrypt__ IC
ic Name
nm RSASecretData
rsd = Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClearText -> Binary
_ClearText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> RSASecretData -> KS ClearText
decryptWithRSAKeyKS_ Name
nm RSASecretData
rsd)
sign :: IC -> Name -> FilePath -> FilePath -> IO ()
sign :: IC -> Name -> String -> String -> IO ()
sign IC
ic Name
nm String
s_fp String
d_fp =
do ByteString
bs <- String -> IO ByteString
B.readFile String
s_fp
ByteString
bs' <- IC -> Name -> ByteString -> IO ByteString
sign_ IC
ic Name
nm ByteString
bs
String -> ByteString -> IO ()
B.writeFile String
d_fp ByteString
bs'
sign_ :: IC -> Name -> B.ByteString -> IO B.ByteString
sign_ :: IC -> Name -> ByteString -> IO ByteString
sign_ IC
ic Name
nm ByteString
m_bs = Binary -> ByteString
_Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePacket -> Binary
_SignaturePacket forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ Name -> ClearText -> KS SignaturePacket
signWithRSAKeyKS Name
nm forall a b. (a -> b) -> a -> b
$ Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
m_bs)
verify :: IC -> FilePath -> FilePath -> IO Bool
verify :: IC -> String -> String -> IO Bool
verify IC
ic String
m_fp String
s_fp =
do ByteString
m_bs <- String -> IO ByteString
B.readFile String
m_fp
ByteString
s_bs <- String -> IO ByteString
B.readFile String
s_fp
Bool
ok <- IC -> ByteString -> ByteString -> IO Bool
verify_ IC
ic ByteString
m_bs ByteString
s_bs
case Bool
ok of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> IO ()
report String
"signature does not match the data"
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
ok
verify_ :: IC -> B.ByteString -> B.ByteString -> IO Bool
verify_ :: IC -> ByteString -> ByteString -> IO Bool
verify_ IC
ic ByteString
m_bs ByteString
s_bs =
forall a. IC -> KS a -> IO a
run IC
ic forall a b. (a -> b) -> a -> b
$ ClearText -> SignaturePacket -> KS Bool
verifyWithRSAKeyKS (Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
m_bs)
(Binary -> SignaturePacket
SignaturePacket forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
s_bs)
run :: IC -> KS a -> IO a
run :: forall a. IC -> KS a -> IO a
run IC
ic KS a
p =
do (Ctx
ctx,State
st0) <- IC -> IO (Ctx, State)
getCtxState IC
ic
State
st1 <- Ctx -> State -> IO State
scan_env Ctx
ctx State
st0
let msg :: String
msg = String
"[Keystore: " forall a. [a] -> [a] -> [a]
++ Ctx -> String
ctx_store Ctx
ctx forall a. [a] -> [a] -> [a]
++String
"]\n"
(E a
e,State
st2,[LogEntry]
les) = forall a. Ctx -> State -> KS a -> (E a, State, [LogEntry])
run_ Ctx
ctx State
st1 forall a b. (a -> b) -> a -> b
$ String -> KS ()
debugLog String
msg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KS a
p
a
r <- forall a. E a -> IO a
e2io E a
e
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ctx -> LogEntry -> IO ()
logit Ctx
ctx) [LogEntry]
les
State
st' <- Ctx -> State -> IO State
backup_env Ctx
ctx State
st2
IC -> Ctx -> State -> IO ()
putCtxState IC
ic Ctx
ctx State
st'
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
scan_env :: Ctx -> State -> IO State
scan_env :: Ctx -> State -> IO State
scan_env Ctx
ctx State
st0 =
do (KeyStore
ks,[LogEntry]
les) <- KeyStore -> IO (KeyStore, [LogEntry])
scanEnv KeyStore
ks0
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ctx -> LogEntry -> IO ()
logit Ctx
ctx) [LogEntry]
les
forall (m :: * -> *) a. Monad m => a -> m a
return State
st0 { st_keystore :: KeyStore
st_keystore = KeyStore
ks }
where
ks0 :: KeyStore
ks0 = State -> KeyStore
st_keystore State
st0
backup_env :: Ctx -> State -> IO State
backup_env :: Ctx -> State -> IO State
backup_env Ctx
ctx State
st0 =
do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ctx -> LogEntry -> IO ()
logit Ctx
ctx) [LogEntry]
les'
forall a. E a -> IO a
e2io E ()
e
forall (m :: * -> *) a. Monad m => a -> m a
return State
st'
where
(E ()
e,State
st',[LogEntry]
les') = forall a. Ctx -> State -> KS a -> (E a, State, [LogEntry])
run_ Ctx
ctx State
st0 KS ()
backupKeysKS
getKeystore :: IC -> IO KeyStore
getKeystore :: IC -> IO KeyStore
getKeystore IC
ic = State -> KeyStore
st_keystore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO State
getState IC
ic
getState :: IC -> IO State
getState :: IC -> IO State
getState IC
ic = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IC -> IO (Ctx, State)
getCtxState IC
ic
getCtxState :: IC -> IO (Ctx,State)
getCtxState :: IC -> IO (Ctx, State)
getCtxState IC{Maybe (IORef (Ctx, State))
CtxParams
ic_cache :: IC -> Maybe (IORef (Ctx, State))
ic_ctx_params :: IC -> CtxParams
ic_cache :: Maybe (IORef (Ctx, State))
ic_ctx_params :: CtxParams
..} =
case Maybe (IORef (Ctx, State))
ic_cache of
Maybe (IORef (Ctx, State))
Nothing -> CtxParams -> IO (Ctx, State)
determineCtx CtxParams
ic_ctx_params
Just IORef (Ctx, State)
rf -> forall a. IORef a -> IO a
readIORef IORef (Ctx, State)
rf
putCtxState :: IC -> Ctx -> State -> IO ()
putCtxState :: IC -> Ctx -> State -> IO ()
putCtxState IC{Maybe (IORef (Ctx, State))
CtxParams
ic_cache :: Maybe (IORef (Ctx, State))
ic_ctx_params :: CtxParams
ic_cache :: IC -> Maybe (IORef (Ctx, State))
ic_ctx_params :: IC -> CtxParams
..} Ctx
ctx State
st =
do forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IORef a -> a -> IO ()
writeIORef (Ctx
ctx,State
st)) Maybe (IORef (Ctx, State))
ic_cache
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ CtxParams -> Maybe Bool
cp_readonly CtxParams
ic_ctx_params) forall a b. (a -> b) -> a -> b
$
String -> ByteString -> IO ()
LBS.writeFile (Ctx -> String
ctx_store Ctx
ctx) forall a b. (a -> b) -> a -> b
$ KeyStore -> ByteString
keyStoreBytes forall a b. (a -> b) -> a -> b
$ State -> KeyStore
st_keystore State
st
report :: String -> IO ()
report :: String -> IO ()
report = Handle -> String -> IO ()
hPutStrLn Handle
stderr