module Hackage.Security.Trusted.TCB (
Trusted(DeclareTrusted)
, trusted
, trustStatic
, trustVerified
, trustApply
, trustElems
, VerificationError(..)
, RootUpdated(..)
, VerificationHistory
, SignaturesVerified
, signaturesVerified
, verifyRole'
, verifyFingerprints
, StaticPtr
) where
import Prelude
import Control.Exception
import Control.Monad (when, unless)
import Control.Monad.Except (Except, runExcept, throwError)
import Data.Typeable
import Data.Time
import Hackage.Security.TUF
import Hackage.Security.JSON
import Hackage.Security.Key
import Hackage.Security.Util.Pretty
import qualified Hackage.Security.Util.Lens as Lens
import GHC.StaticPtr
newtype Trusted a = DeclareTrusted { forall a. Trusted a -> a
trusted :: a }
deriving (Trusted a -> Trusted a -> Bool
(Trusted a -> Trusted a -> Bool)
-> (Trusted a -> Trusted a -> Bool) -> Eq (Trusted a)
forall a. Eq a => Trusted a -> Trusted a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Trusted a -> Trusted a -> Bool
== :: Trusted a -> Trusted a -> Bool
$c/= :: forall a. Eq a => Trusted a -> Trusted a -> Bool
/= :: Trusted a -> Trusted a -> Bool
Eq, Int -> Trusted a -> ShowS
[Trusted a] -> ShowS
Trusted a -> String
(Int -> Trusted a -> ShowS)
-> (Trusted a -> String)
-> ([Trusted a] -> ShowS)
-> Show (Trusted a)
forall a. Show a => Int -> Trusted a -> ShowS
forall a. Show a => [Trusted a] -> ShowS
forall a. Show a => Trusted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Trusted a -> ShowS
showsPrec :: Int -> Trusted a -> ShowS
$cshow :: forall a. Show a => Trusted a -> String
show :: Trusted a -> String
$cshowList :: forall a. Show a => [Trusted a] -> ShowS
showList :: [Trusted a] -> ShowS
Show)
trustStatic :: StaticPtr a -> Trusted a
trustStatic :: forall a. StaticPtr a -> Trusted a
trustStatic = a -> Trusted a
forall a. a -> Trusted a
DeclareTrusted (a -> Trusted a) -> (StaticPtr a -> a) -> StaticPtr a -> Trusted a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticPtr a -> a
forall a. StaticPtr a -> a
deRefStaticPtr
trustVerified :: SignaturesVerified a -> Trusted a
trustVerified :: forall a. SignaturesVerified a -> Trusted a
trustVerified = a -> Trusted a
forall a. a -> Trusted a
DeclareTrusted (a -> Trusted a)
-> (SignaturesVerified a -> a) -> SignaturesVerified a -> Trusted a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturesVerified a -> a
forall a. SignaturesVerified a -> a
signaturesVerified
trustApply :: Trusted (a -> b) -> Trusted a -> Trusted b
trustApply :: forall a b. Trusted (a -> b) -> Trusted a -> Trusted b
trustApply (DeclareTrusted a -> b
f) (DeclareTrusted a
x) = b -> Trusted b
forall a. a -> Trusted a
DeclareTrusted (a -> b
f a
x)
trustElems :: Traversable f => Trusted (f a) -> f (Trusted a)
trustElems :: forall (f :: * -> *) a.
Traversable f =>
Trusted (f a) -> f (Trusted a)
trustElems (DeclareTrusted f a
fa) = a -> Trusted a
forall a. a -> Trusted a
DeclareTrusted (a -> Trusted a) -> f a -> f (Trusted a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` f a
fa
newtype SignaturesVerified a = SignaturesVerified { forall a. SignaturesVerified a -> a
signaturesVerified :: a }
data VerificationError =
VerificationErrorSignatures TargetPath
Integer
[KeyId]
[KeyId]
| VerificationErrorExpired TargetPath
| VerificationErrorVersion TargetPath
| VerificationErrorFileInfo TargetPath
| VerificationErrorUnknownTarget TargetPath
| VerificationErrorMissingSHA256 TargetPath
| VerificationErrorDeserialization TargetPath DeserializationError
| VerificationErrorLoop VerificationHistory
deriving (Typeable)
data RootUpdated = RootUpdated
deriving (Typeable)
type VerificationHistory = [Either RootUpdated VerificationError]
deriving instance Show VerificationError
deriving instance Show RootUpdated
instance Exception VerificationError where displayException :: VerificationError -> String
displayException = VerificationError -> String
forall a. Pretty a => a -> String
pretty
instance Exception RootUpdated where displayException :: RootUpdated -> String
displayException = RootUpdated -> String
forall a. Pretty a => a -> String
pretty
indentedLines :: [String] -> String
indentedLines :: [String] -> String
indentedLines = [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
instance Pretty VerificationError where
pretty :: VerificationError -> String
pretty (VerificationErrorSignatures TargetPath
file Integer
threshold [KeyId]
trusted [KeyId]
sigs) =
TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not have enough signatures signed with the appropriate keys\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Expected at least " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
threshold String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" signatures from:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
indentedLines ((KeyId -> String) -> [KeyId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map KeyId -> String
keyIdString [KeyId]
trusted)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Found signatures from:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
indentedLines ((KeyId -> String) -> [KeyId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map KeyId -> String
keyIdString [KeyId]
sigs)
pretty (VerificationErrorExpired TargetPath
file) =
TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is expired"
pretty (VerificationErrorVersion TargetPath
file) =
String
"Version of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is less than the previous version"
pretty (VerificationErrorFileInfo TargetPath
file) =
String
"Invalid hash for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file
pretty (VerificationErrorUnknownTarget TargetPath
file) =
TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in corresponding target metadata"
pretty (VerificationErrorMissingSHA256 TargetPath
file) =
String
"Missing SHA256 hash for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file
pretty (VerificationErrorDeserialization TargetPath
file DeserializationError
err) =
String
"Could not deserialize " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetPath -> String
forall a. Pretty a => a -> String
pretty TargetPath
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeserializationError -> String
forall a. Pretty a => a -> String
pretty DeserializationError
err
pretty (VerificationErrorLoop VerificationHistory
es) =
String
"Verification loop. Errors in order:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
indentedLines ((Either RootUpdated VerificationError -> String)
-> VerificationHistory -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((RootUpdated -> String)
-> (VerificationError -> String)
-> Either RootUpdated VerificationError
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RootUpdated -> String
forall a. Pretty a => a -> String
pretty VerificationError -> String
forall a. Pretty a => a -> String
pretty) VerificationHistory
es)
instance Pretty RootUpdated where
pretty :: RootUpdated -> String
pretty RootUpdated
RootUpdated = String
"Root information updated"
verifyRole' :: forall a. HasHeader a
=> Trusted (RoleSpec a)
-> TargetPath
-> Maybe FileVersion
-> Maybe UTCTime
-> Signed a -> Either VerificationError (SignaturesVerified a)
verifyRole' :: forall a.
HasHeader a =>
Trusted (RoleSpec a)
-> TargetPath
-> Maybe FileVersion
-> Maybe UTCTime
-> Signed a
-> Either VerificationError (SignaturesVerified a)
verifyRole' (Trusted (RoleSpec a) -> RoleSpec a
forall a. Trusted a -> a
trusted -> RoleSpec{roleSpecThreshold :: forall a. RoleSpec a -> KeyThreshold
roleSpecThreshold = KeyThreshold Int54
threshold, [Some PublicKey]
roleSpecKeys :: [Some PublicKey]
roleSpecKeys :: forall a. RoleSpec a -> [Some PublicKey]
..})
TargetPath
targetPath
Maybe FileVersion
mPrev
Maybe UTCTime
mNow
Signed{signatures :: forall a. Signed a -> Signatures
signatures = Signatures [Signature]
sigs, a
signed :: a
signed :: forall a. Signed a -> a
..} =
Except VerificationError (SignaturesVerified a)
-> Either VerificationError (SignaturesVerified a)
forall e a. Except e a -> Either e a
runExcept Except VerificationError (SignaturesVerified a)
go
where
go :: Except VerificationError (SignaturesVerified a)
go :: Except VerificationError (SignaturesVerified a)
go = do
case Maybe UTCTime
mNow of
Just UTCTime
now ->
Bool
-> ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime -> FileExpires -> Bool
isExpired UTCTime
now (LensLike' (Const FileExpires) a FileExpires -> a -> FileExpires
forall a s. LensLike' (Const a) s a -> s -> a
Lens.get LensLike' (Const FileExpires) a FileExpires
forall a. HasHeader a => Lens' a FileExpires
Lens' a FileExpires
fileExpires a
signed)) (ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ())
-> ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ()
forall a b. (a -> b) -> a -> b
$
VerificationError -> ExceptT VerificationError Identity ()
forall a. VerificationError -> ExceptT VerificationError Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (VerificationError -> ExceptT VerificationError Identity ())
-> VerificationError -> ExceptT VerificationError Identity ()
forall a b. (a -> b) -> a -> b
$ TargetPath -> VerificationError
VerificationErrorExpired TargetPath
targetPath
Maybe UTCTime
_otherwise ->
() -> ExceptT VerificationError Identity ()
forall a. a -> ExceptT VerificationError Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe FileVersion
mPrev of
Maybe FileVersion
Nothing -> () -> ExceptT VerificationError Identity ()
forall a. a -> ExceptT VerificationError Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FileVersion
prev ->
Bool
-> ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LensLike' (Const FileVersion) a FileVersion -> a -> FileVersion
forall a s. LensLike' (Const a) s a -> s -> a
Lens.get LensLike' (Const FileVersion) a FileVersion
forall a. HasHeader a => Lens' a FileVersion
Lens' a FileVersion
fileVersion a
signed FileVersion -> FileVersion -> Bool
forall a. Ord a => a -> a -> Bool
< FileVersion
prev) (ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ())
-> ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ()
forall a b. (a -> b) -> a -> b
$
VerificationError -> ExceptT VerificationError Identity ()
forall a. VerificationError -> ExceptT VerificationError Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (VerificationError -> ExceptT VerificationError Identity ())
-> VerificationError -> ExceptT VerificationError Identity ()
forall a b. (a -> b) -> a -> b
$ TargetPath -> VerificationError
VerificationErrorVersion TargetPath
targetPath
let nSigs :: Int
nSigs = [Signature] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Signature -> Bool) -> [Signature] -> [Signature]
forall a. (a -> Bool) -> [a] -> [a]
filter Signature -> Bool
isRoleSpecKey [Signature]
sigs)
Bool
-> ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
nSigs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int54 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int54
threshold) (ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ())
-> ExceptT VerificationError Identity ()
-> ExceptT VerificationError Identity ()
forall a b. (a -> b) -> a -> b
$
VerificationError -> ExceptT VerificationError Identity ()
forall a. VerificationError -> ExceptT VerificationError Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (VerificationError -> ExceptT VerificationError Identity ())
-> VerificationError -> ExceptT VerificationError Identity ()
forall a b. (a -> b) -> a -> b
$ TargetPath -> Integer -> [KeyId] -> [KeyId] -> VerificationError
VerificationErrorSignatures TargetPath
targetPath (Int54 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int54
threshold) [KeyId]
trustedKeys [KeyId]
signingKeys
SignaturesVerified a
-> Except VerificationError (SignaturesVerified a)
forall a. a -> ExceptT VerificationError Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignaturesVerified a
-> Except VerificationError (SignaturesVerified a))
-> SignaturesVerified a
-> Except VerificationError (SignaturesVerified a)
forall a b. (a -> b) -> a -> b
$ a -> SignaturesVerified a
forall a. a -> SignaturesVerified a
SignaturesVerified a
signed
isRoleSpecKey :: Signature -> Bool
isRoleSpecKey :: Signature -> Bool
isRoleSpecKey Signature{ByteString
Some PublicKey
signature :: ByteString
signatureKey :: Some PublicKey
signatureKey :: Signature -> Some PublicKey
signature :: Signature -> ByteString
..} = Some PublicKey
signatureKey Some PublicKey -> [Some PublicKey] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Some PublicKey]
roleSpecKeys
trustedKeys, signingKeys :: [KeyId]
trustedKeys :: [KeyId]
trustedKeys = (Some PublicKey -> KeyId) -> [Some PublicKey] -> [KeyId]
forall a b. (a -> b) -> [a] -> [b]
map Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId [Some PublicKey]
roleSpecKeys
signingKeys :: [KeyId]
signingKeys = (Signature -> KeyId) -> [Signature] -> [KeyId]
forall a b. (a -> b) -> [a] -> [b]
map (Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId (Some PublicKey -> KeyId)
-> (Signature -> Some PublicKey) -> Signature -> KeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Some PublicKey
signatureKey) [Signature]
sigs
verifyFingerprints :: [KeyId]
-> KeyThreshold
-> TargetPath
-> Signed Root
-> Either VerificationError (SignaturesVerified Root)
verifyFingerprints :: [KeyId]
-> KeyThreshold
-> TargetPath
-> Signed Root
-> Either VerificationError (SignaturesVerified Root)
verifyFingerprints [KeyId]
fingerprints
(KeyThreshold Int54
threshold)
TargetPath
targetPath
Signed{signatures :: forall a. Signed a -> Signatures
signatures = Signatures [Signature]
sigs, Root
signed :: forall a. Signed a -> a
signed :: Root
..} =
if [KeyId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((KeyId -> Bool) -> [KeyId] -> [KeyId]
forall a. (a -> Bool) -> [a] -> [a]
filter KeyId -> Bool
isTrustedKey [KeyId]
signingKeys) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int54 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int54
threshold
then SignaturesVerified Root
-> Either VerificationError (SignaturesVerified Root)
forall a b. b -> Either a b
Right (SignaturesVerified Root
-> Either VerificationError (SignaturesVerified Root))
-> SignaturesVerified Root
-> Either VerificationError (SignaturesVerified Root)
forall a b. (a -> b) -> a -> b
$ Root -> SignaturesVerified Root
forall a. a -> SignaturesVerified a
SignaturesVerified Root
signed
else VerificationError
-> Either VerificationError (SignaturesVerified Root)
forall a b. a -> Either a b
Left (VerificationError
-> Either VerificationError (SignaturesVerified Root))
-> VerificationError
-> Either VerificationError (SignaturesVerified Root)
forall a b. (a -> b) -> a -> b
$ TargetPath -> Integer -> [KeyId] -> [KeyId] -> VerificationError
VerificationErrorSignatures TargetPath
targetPath (Int54 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int54
threshold) [KeyId]
fingerprints [KeyId]
signingKeys
where
signingKeys :: [KeyId]
signingKeys :: [KeyId]
signingKeys = (Signature -> KeyId) -> [Signature] -> [KeyId]
forall a b. (a -> b) -> [a] -> [b]
map (Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId (Some PublicKey -> KeyId)
-> (Signature -> Some PublicKey) -> Signature -> KeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Some PublicKey
signatureKey) [Signature]
sigs
isTrustedKey :: KeyId -> Bool
isTrustedKey :: KeyId -> Bool
isTrustedKey KeyId
key = KeyId
key KeyId -> [KeyId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeyId]
fingerprints