module Network.AdHoc.Signature
(Signature(..)
,SignType(..)
,SignatureStatus(..)
,NoSignature
,InternalSignature
,ExternalSignature
,ToInternalSignature(..)
,getHashString
,verifySignature
) where
import Data.ByteString hiding (foldl,concatMap)
import Text.XML.HaXml.Types
import Codec.Binary.UTF8.String (encodeString)
import qualified Network.GnuTLS.X509 as X509
data Signature = Signature
{sign_type :: SignType
,signature :: ByteString
}
deriving (Show,Eq)
data SignType
= MD5
| SignUnknown String
deriving (Show,Eq)
data SignatureStatus
= SignatureOK
| SignatureWrong
| CertificateMissing (X509.Certificate -> SignatureStatus)
instance Show SignatureStatus where
show SignatureOK = "SignatureOK"
show SignatureWrong = "SignatureWrong"
show (CertificateMissing _) = "CertificateMissing"
instance Eq SignatureStatus where
SignatureOK == SignatureOK = True
SignatureWrong == SignatureWrong = True
_ == _ = False
type NoSignature = ()
type InternalSignature = Either X509.PrivateKey ExternalSignature
type ExternalSignature = Maybe (Signature,SignatureStatus)
class ToInternalSignature s where
toInternal :: s -> InternalSignature
instance ToInternalSignature NoSignature where
toInternal _ = Right Nothing
instance ToInternalSignature ExternalSignature where
toInternal = Right
instance ToInternalSignature InternalSignature where
toInternal = id
verifySignature :: String -> Signature -> X509.Certificate -> SignatureStatus
verifySignature str sig cert = case X509.verifySignature cert (encodeString str) (signature sig) of
Left _ -> CertificateMissing (verifySignature (encodeString str) sig)
Right False -> SignatureWrong
Right True -> SignatureOK
getHashString :: [Content i] -> String
getHashString = concatMap getHashStringContent
getHashStringContent :: Content i -> String
getHashStringContent (CElem (Elem "receiver" _ _) _) = ""
getHashStringContent (CElem (Elem _ _ conts) _) = getHashString conts
getHashStringContent (CString _ str _) = str
getHashStringContent _ = ""