module Data.Conduit.OpenPGP.Keyring (
conduitToTKs
, sinkKeyringMap
) where
import qualified Data.ByteString as B
import Data.Conduit
import Data.Map (Map)
import qualified Data.Map as Map
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID)
import Codec.Encryption.OpenPGP.Types
data Phase = MainKey | Revs | Uids | UAts | Subs
deriving (Eq, Ord, Show)
conduitToTKs :: Resource m => Conduit Packet m TK
conduitToTKs = conduitState (MainKey, NoTK) push close
where
push state input = case (state, input) of
((MainKey, _), PublicKey pkp) -> return $ StateProducing (Revs, TPK pkp [] [] [] []) []
((MainKey, _), SecretKey pkp ska) -> return $ StateProducing (Revs, TSK (SecretKey pkp ska) [] [] [] []) []
((Revs, TPK pkp revs uids uats subs), Signature s) -> return $ StateProducing (Revs, TPK pkp (revs ++ [s]) uids uats subs) []
((Revs, TPK pkp revs uids uats subs), UserId u) -> return $ StateProducing (Uids, TPK pkp revs [(u, [])] uats subs) []
((Uids, TPK pkp revs uids uats subs), Signature s) -> return $ StateProducing (Uids, TPK pkp revs (addUidSig s uids) uats subs) []
((Uids, TPK pkp revs uids uats subs), UserId u) -> return $ StateProducing (Uids, TPK pkp revs (uids ++ [(u, [])]) uats subs) []
((Uids, TPK pkp revs uids uats subs), UserAttribute u) -> return $ StateProducing (UAts, TPK pkp revs uids [(u, [])] subs) []
((Uids, TPK pkp revs uids uats subs), PublicSubkey p) -> return $ StateProducing (Subs, TPK pkp revs uids uats [(p, SigVOther 0 B.empty, Nothing)]) []
((Uids, TPK pkp revs uids uats subs), PublicKey p) -> return $ StateProducing (Revs, TPK p [] [] [] []) [TPK pkp revs uids uats subs]
((UAts, TPK pkp revs uids uats subs), Signature s) -> return $ StateProducing (UAts, TPK pkp revs uids (addUAtSig s uats) subs) []
((UAts, TPK pkp revs uids uats subs), UserAttribute u) -> return $ StateProducing (UAts, TPK pkp revs uids (uats ++ [(u, [])]) subs) []
((UAts, TPK pkp revs uids uats subs), UserId u) -> return $ StateProducing (Uids, TPK pkp revs (uids ++ [(u, [])]) uats subs) []
((UAts, TPK pkp revs uids uats subs), PublicSubkey p) -> return $ StateProducing (Subs, TPK pkp revs uids uats [(p, SigVOther 0 B.empty, Nothing)]) []
((UAts, TPK pkp revs uids uats subs), PublicKey p) -> return $ StateProducing (Revs, TPK p [] [] [] []) [TPK pkp revs uids uats subs]
((Subs, TPK pkp revs uids uats subs), PublicSubkey p) -> return $ StateProducing (Subs, TPK pkp revs uids uats (subs ++ [(p, SigVOther 0 B.empty, Nothing)])) []
((Subs, TPK pkp revs uids uats subs), Signature s) -> case sType s of
SubkeyBindingSig -> return $ StateProducing (Subs, TPK pkp revs uids uats (setBSig s subs)) []
SubkeyRevocationSig -> return $ StateProducing (Subs, TPK pkp revs uids uats (setRSig s subs)) []
otherwise -> error $ "Unexpected subkey sig: " ++ show (fst state) ++ "/" ++ show input
((Subs, TPK pkp revs uids uats subs), PublicKey p) -> return $ StateProducing (Revs, TPK p [] [] [] []) [TPK pkp revs uids uats subs]
((Revs, TSK skp revs uids uats subs), Signature s) -> return $ StateProducing (Revs, TSK skp (revs ++ [s]) uids uats subs) []
((Revs, TSK skp revs uids uats subs), UserId u) -> return $ StateProducing (Uids, TSK skp revs [(u, [])] uats subs) []
((Uids, TSK skp revs uids uats subs), Signature s) -> return $ StateProducing (Uids, TSK skp revs (addUidSig s uids) uats subs) []
((Uids, TSK skp revs uids uats subs), UserId u) -> return $ StateProducing (Uids, TSK skp revs (uids ++ [(u, [])]) uats subs) []
((Uids, TSK skp revs uids uats subs), UserAttribute u) -> return $ StateProducing (UAts, TSK skp revs uids [(u, [])] subs) []
((Uids, TSK skp revs uids uats subs), SecretSubkey p s) -> return $ StateProducing (Subs, TSK skp revs uids uats [(SecretSubkey p s, SigVOther 0 B.empty, Nothing)]) []
((Uids, TSK skp revs uids uats subs), SecretKey p s) -> return $ StateProducing (Revs, TSK (SecretKey p s) [] [] [] []) [TSK skp revs uids uats subs]
((UAts, TSK skp revs uids uats subs), Signature s) -> return $ StateProducing (UAts, TSK skp revs uids (addUAtSig s uats) subs) []
((UAts, TSK skp revs uids uats subs), UserAttribute u) -> return $ StateProducing (UAts, TSK skp revs uids (uats ++ [(u, [])]) subs) []
((UAts, TSK skp revs uids uats subs), UserId u) -> return $ StateProducing (Uids, TSK skp revs (uids ++ [(u, [])]) uats subs) []
((UAts, TSK skp revs uids uats subs), SecretSubkey p s) -> return $ StateProducing (Subs, TSK skp revs uids uats [(SecretSubkey p s, SigVOther 0 B.empty, Nothing)]) []
((UAts, TSK skp revs uids uats subs), SecretKey p s) -> return $ StateProducing (Revs, TSK (SecretKey p s) [] [] [] []) [TSK skp revs uids uats subs]
((Subs, TSK skp revs uids uats subs), SecretSubkey p s) -> return $ StateProducing (Subs, TSK skp revs uids uats (subs ++ [(SecretSubkey p s, SigVOther 0 B.empty, Nothing)])) []
((Subs, TSK skp revs uids uats subs), Signature s) -> case sType s of
SubkeyBindingSig -> return $ StateProducing (Subs, TSK skp revs uids uats (setBSig s subs)) []
SubkeyRevocationSig -> return $ StateProducing (Subs, TSK skp revs uids uats (setRSig s subs)) []
otherwise -> error $ "Unexpected subkey sig: " ++ show (fst state) ++ "/" ++ show input
((Subs, TSK skp revs uids uats subs), SecretKey p s) -> return $ StateProducing (Revs, TSK (SecretKey p s) [] [] [] []) [TSK skp revs uids uats subs]
((_,_), Trust _) -> return $ StateProducing state []
otherwise -> error $ "Unexpected packet: " ++ show (fst state) ++ "/" ++ show input
close (_, tk) = return [tk]
addUidSig s uids = init uids ++ [(\(u, us) -> (u, us ++ [s])) (last uids)]
addUAtSig s uats = init uats ++ [(\(u, us) -> (u, us ++ [s])) (last uats)]
setBSig s subs = init subs ++ [(\(p, b, r) -> (p, s, r)) (last subs)]
setRSig s subs = init subs ++ [(\(p, b, r) -> (p, b, Just s)) (last subs)]
sType (SigV3 st _ _ _ _ _ _) = st
sType (SigV4 st _ _ _ _ _ _) = st
sinkKeyringMap :: Resource m => Sink TK m (Map EightOctetKeyId TK)
sinkKeyringMap = sinkState Map.empty push close
where
push :: Resource m => Map EightOctetKeyId TK -> TK -> ResourceT m (SinkStateResult (Map EightOctetKeyId TK) TK (Map EightOctetKeyId TK))
push state input = return $ StateProcessing $ Map.insert (eok input) input state
close state = return state
eok (TPK pkp _ _ _ _) = eightOctetKeyID pkp
eok (TSK (SecretKey p s) _ _ _ _) = eightOctetKeyID p