module Hackage.Security.Trusted.TCB (
Trusted(DeclareTrusted)
, trusted
, trustStatic
, trustVerified
, trustApply
, trustSeq
, VerificationError(..)
, RootUpdated(..)
, VerificationHistory
, SignaturesVerified
, signaturesVerified
, verifyRole'
, verifyFingerprints
#if __GLASGOW_HASKELL__ >= 710
, StaticPtr
#else
, StaticPtr
, static
#endif
) where
import Control.Exception
import Control.Monad.Except
import Data.Typeable
import Data.Time
import Hackage.Security.TUF
import Hackage.Security.Key
import Hackage.Security.Util.Pretty
import qualified Hackage.Security.Util.Lens as Lens
#if __GLASGOW_HASKELL__ >= 710
import GHC.StaticPtr
#else
newtype StaticPtr a = StaticPtr { deRefStaticPtr :: a }
static :: a -> StaticPtr a
static = StaticPtr
#endif
newtype Trusted a = DeclareTrusted { trusted :: a }
deriving (Eq, Show)
trustStatic :: StaticPtr a -> Trusted a
trustStatic = DeclareTrusted . deRefStaticPtr
trustVerified :: SignaturesVerified a -> Trusted a
trustVerified = DeclareTrusted . signaturesVerified
trustApply :: Trusted (a -> b) -> Trusted a -> Trusted b
trustApply (DeclareTrusted f) (DeclareTrusted x) = DeclareTrusted (f x)
trustSeq :: Functor f => Trusted (f a) -> f (Trusted a)
trustSeq (DeclareTrusted fa) = DeclareTrusted `fmap` fa
newtype SignaturesVerified a = SignaturesVerified { signaturesVerified :: a }
data VerificationError =
VerificationErrorSignatures TargetPath
| VerificationErrorExpired TargetPath
| VerificationErrorVersion TargetPath
| VerificationErrorFileInfo TargetPath
| VerificationErrorUnknownTarget TargetPath
| VerificationErrorFileTooLarge TargetPath
| VerificationErrorLoop VerificationHistory
deriving (Typeable)
data RootUpdated = RootUpdated
deriving (Typeable)
type VerificationHistory = [Either RootUpdated VerificationError]
#if MIN_VERSION_base(4,8,0)
deriving instance Show VerificationError
deriving instance Show RootUpdated
instance Exception VerificationError where displayException = pretty
instance Exception RootUpdated where displayException = pretty
#else
instance Exception VerificationError
instance Show VerificationError where show = pretty
instance Show RootUpdated where show = pretty
instance Exception RootUpdated
#endif
instance Pretty VerificationError where
pretty (VerificationErrorSignatures file) =
pretty file ++ " does not have enough signatures signed with the appropriate keys"
pretty (VerificationErrorExpired file) =
pretty file ++ " is expired"
pretty (VerificationErrorVersion file) =
"Version of " ++ pretty file ++ " is less than the previous version"
pretty (VerificationErrorFileInfo file) =
"Invalid hash for " ++ pretty file
pretty (VerificationErrorUnknownTarget file) =
pretty file ++ " not found in corresponding target metadata"
pretty (VerificationErrorFileTooLarge file) =
pretty file ++ " too large"
pretty (VerificationErrorLoop es) =
"Verification loop. Errors in order:\n"
++ unlines (map ((" " ++) . either pretty pretty) es)
instance Pretty RootUpdated where
pretty RootUpdated = "Root information updated"
verifyRole' :: forall a. HasHeader a
=> Trusted (RoleSpec a)
-> TargetPath
-> Maybe FileVersion
-> Maybe UTCTime
-> Signed a -> Either VerificationError (SignaturesVerified a)
verifyRole' (trusted -> RoleSpec{roleSpecThreshold = KeyThreshold threshold, ..})
targetPath
mPrev
mNow
Signed{signatures = Signatures sigs, ..} =
runExcept go
where
go :: Except VerificationError (SignaturesVerified a)
go = do
case mNow of
Just now ->
when (isExpired now (Lens.get fileExpires signed)) $
throwError $ VerificationErrorExpired targetPath
_otherwise ->
return ()
case mPrev of
Nothing -> return ()
Just prev ->
when (Lens.get fileVersion signed < prev) $
throwError $ VerificationErrorVersion targetPath
unless (length (filter isRoleSpecKey sigs) >= threshold) $
throwError $ VerificationErrorSignatures targetPath
return $ SignaturesVerified signed
isRoleSpecKey :: Signature -> Bool
isRoleSpecKey Signature{..} = signatureKey `elem` roleSpecKeys
verifyFingerprints :: [KeyId]
-> KeyThreshold
-> TargetPath
-> Signed Root
-> Either VerificationError (SignaturesVerified Root)
verifyFingerprints fingerprints
(KeyThreshold threshold)
targetPath
Signed{signatures = Signatures sigs, ..} =
if length (filter isTrustedKey sigs) >= threshold
then Right $ SignaturesVerified signed
else Left $ VerificationErrorSignatures targetPath
where
isTrustedKey :: Signature -> Bool
isTrustedKey Signature{..} = someKeyId signatureKey `elem` fingerprints