{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns #-} module Network.Hermes.Signature( Authority(..), SignatureRequest(..) ,newAuthority ,newSignatureRequest ,signRequest ,newSignedContext ) where import Control.Applicative import Data.Serialize import qualified Data.ByteString as B import Codec.Crypto.RSA import Network.Hermes.Types import Network.Hermes.Protocol import Network.Hermes.Misc import Codec.Crypto.AES.Random import Network.Hermes.Core(newContext,setKeySignature,addAuthority) newtype SignatureRequest = SignatureRequest B.ByteString deriving(Serialize) data Authority = Authority { authorityPrivateKey :: PrivateKey, authorityKey :: PublicKey } deriving(Show) instance Serialize Authority where put (Authority a b) = put a >> put b get = Authority <$> get <*> get newAuthority :: IO Authority newAuthority = do g <- newAESGen let (pub,priv,_) = generateKeyPair g rsaKeySize return $ Authority priv pub -- | Creates a signature request, to fullfill on another computer. newSignatureRequest :: CoreContext -> SignatureRequest newSignatureRequest = SignatureRequest . encode . myKey -- | Sign a request. Use setKeySignature to install it. signRequest :: Authority -> SignatureRequest -> Signature signRequest (authorityPrivateKey -> key) (SignatureRequest req) = rsaSign key req -- | Creates a pre-signed Context, with this authority set as trusted newSignedContext :: Authority -> IO CoreContext newSignedContext authority = do ctx <- newContext let sig = signRequest authority $ newSignatureRequest ctx setKeySignature ctx sig addAuthority ctx (authorityKey authority) return ctx