{- Copyright 2017 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE OverloadedStrings, RankNTypes, DeriveGeneric #-} module Crypto where import Val import Hash import Types import qualified Crypto.PubKey.Ed25519 as Ed25519 import Crypto.Error import Crypto.Random.Entropy import Data.ByteArray (convert) import qualified Data.ByteString as B import qualified Data.Semigroup as Sem dummySignature :: Signature dummySignature = OtherSignature (Val mempty) class Signed t where getSignature :: t -> Signature hashExceptSignature :: t -> Hash mkSigned :: MySessionKey -> (Signature -> t) -> t mkSigned sk mk = let tmp = mk dummySignature in mk (sign sk tmp) instance Hashable a => Signed (Activity a) where getSignature = activitySignature hashExceptSignature (Activity a mpa mpe mt _s) = hash $ Tagged "Activity" [hash a, hashOfMaybeUnsafe mpa, hashOfMaybeUnsafe mpe, hash mt] instance Signed Control where getSignature = controlSignature hashExceptSignature (Control a _s) = hash $ Tagged "Control" a instance Hashable t => Signed (Message t) where getSignature (ActivityMessage a) = getSignature a getSignature (ControlMessage c) = getSignature c hashExceptSignature (ActivityMessage a) = hashExceptSignature a hashExceptSignature (ControlMessage c) = hashExceptSignature c instance Signed AnyMessage where getSignature (User m) = getSignature m getSignature (Developer m) = getSignature m hashExceptSignature (User m) = hashExceptSignature m hashExceptSignature (Developer m) = hashExceptSignature m sign :: Signed v => MySessionKey -> v -> Signature sign (MySessionKey sk pk) v = Ed25519Signature $ Val $ convert $ Ed25519.sign sk pk (toSign v) toSign :: Signed v => v -> B.ByteString toSign = val . hashValue . hashExceptSignature -- | Verifiy the signature of a Signed value. verifySigned :: Signed v => SigVerifier -> v -> Bool verifySigned (SigVerifier _ verifier) v = case getSignature v of Ed25519Signature (Val s) -> case Ed25519.signature s of CryptoPassed sig -> verifier (toSign v) sig CryptoFailed _ -> False OtherSignature _ -> False data SigVerifier = SigVerifier Int (B.ByteString -> Ed25519.Signature -> Bool) instance Show SigVerifier where show (SigVerifier n _) = "SigVerifier (" ++ show n ++ ")" mkSigVerifier :: PublicKey -> SigVerifier mkSigVerifier (PublicKey (Val pk)) = case Ed25519.publicKey pk of CryptoPassed pk' -> SigVerifier 1 (Ed25519.verify pk') CryptoFailed _ -> mempty instance Sem.Semigroup SigVerifier where SigVerifier na a <> SigVerifier nb b = SigVerifier (na+nb) $ \d s -> b d s || a d s instance Monoid SigVerifier where mempty = SigVerifier 0 $ \_b _s -> False mappend = (Sem.<>) data MySessionKey = MySessionKey Ed25519.SecretKey Ed25519.PublicKey instance Show MySessionKey where show _ = "" genMySessionKey :: IO MySessionKey genMySessionKey = do -- Crypto.Random.Entropy may use rdrand, or /dev/random. -- Even if you don't trust rdrand to be free of backdoors, -- it seems safe enough to use it for a session key that -- is only used for signing, not encryption. rand32 <- getEntropy 32 :: IO B.ByteString sk <- throwCryptoErrorIO $ Ed25519.secretKey rand32 return $ MySessionKey sk (Ed25519.toPublic sk)