module Hackage.Security.TUF.Signed (
Signed(..)
, Signatures(..)
, Signature(..)
, unsigned
, withSignatures
, withSignatures'
, signRendered
, verifySignature
, signedFromJSON
, verifySignatures
, UninterpretedSignatures(..)
, PreSignature(..)
, fromPreSignature
, fromPreSignatures
, toPreSignature
, toPreSignatures
) where
import Control.Monad
import Data.Functor.Identity
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.Set as Set
import Hackage.Security.JSON
import Hackage.Security.Key
import Hackage.Security.TUF.Layout.Repo
import Hackage.Security.Util.Some
import Text.JSON.Canonical
import qualified Hackage.Security.Util.Base64 as B64
data Signed a = Signed {
Signed a -> a
signed :: a
, Signed a -> Signatures
signatures :: Signatures
}
newtype Signatures = Signatures [Signature]
data Signature = Signature {
Signature -> ByteString
signature :: BS.ByteString
, Signature -> Some PublicKey
signatureKey :: Some PublicKey
}
unsigned :: a -> Signed a
unsigned :: a -> Signed a
unsigned a :: a
a = Signed :: forall a. a -> Signatures -> Signed a
Signed { signed :: a
signed = a
a, signatures :: Signatures
signatures = [Signature] -> Signatures
Signatures [] }
withSignatures :: ToJSON WriteJSON a => RepoLayout -> [Some Key] -> a -> Signed a
withSignatures :: RepoLayout -> [Some Key] -> a -> Signed a
withSignatures repoLayout :: RepoLayout
repoLayout keys :: [Some Key]
keys doc :: a
doc = Signed :: forall a. a -> Signatures -> Signed a
Signed {
signed :: a
signed = a
doc
, signatures :: Signatures
signatures = [Some Key] -> ByteString -> Signatures
signRendered [Some Key]
keys (ByteString -> Signatures) -> ByteString -> Signatures
forall a b. (a -> b) -> a -> b
$ RepoLayout -> a -> ByteString
forall a. ToJSON WriteJSON a => RepoLayout -> a -> ByteString
renderJSON RepoLayout
repoLayout a
doc
}
withSignatures' :: ToJSON Identity a => [Some Key] -> a -> Signed a
withSignatures' :: [Some Key] -> a -> Signed a
withSignatures' keys :: [Some Key]
keys doc :: a
doc = Signed :: forall a. a -> Signatures -> Signed a
Signed {
signed :: a
signed = a
doc
, signatures :: Signatures
signatures = [Some Key] -> ByteString -> Signatures
signRendered [Some Key]
keys (ByteString -> Signatures) -> ByteString -> Signatures
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON Identity a => a -> ByteString
renderJSON_NoLayout a
doc
}
signRendered :: [Some Key] -> BS.L.ByteString -> Signatures
signRendered :: [Some Key] -> ByteString -> Signatures
signRendered keys :: [Some Key]
keys rendered :: ByteString
rendered = [Signature] -> Signatures
Signatures ([Signature] -> Signatures) -> [Signature] -> Signatures
forall a b. (a -> b) -> a -> b
$ (Some Key -> Signature) -> [Some Key] -> [Signature]
forall a b. (a -> b) -> [a] -> [b]
map Some Key -> Signature
go [Some Key]
keys
where
go :: Some Key -> Signature
go :: Some Key -> Signature
go (Some key :: Key a
key) = Signature :: ByteString -> Some PublicKey -> Signature
Signature {
signature :: ByteString
signature = PrivateKey a -> ByteString -> ByteString
forall typ. PrivateKey typ -> ByteString -> ByteString
sign (Key a -> PrivateKey a
forall a. Key a -> PrivateKey a
privateKey Key a
key) ByteString
rendered
, signatureKey :: Some PublicKey
signatureKey = PublicKey a -> Some PublicKey
forall (f :: * -> *) a. f a -> Some f
Some (PublicKey a -> Some PublicKey) -> PublicKey a -> Some PublicKey
forall a b. (a -> b) -> a -> b
$ Key a -> PublicKey a
forall a. Key a -> PublicKey a
publicKey Key a
key
}
verifySignature :: BS.L.ByteString -> Signature -> Bool
verifySignature :: ByteString -> Signature -> Bool
verifySignature inp :: ByteString
inp Signature{signature :: Signature -> ByteString
signature = ByteString
sig, signatureKey :: Signature -> Some PublicKey
signatureKey = Some pub :: PublicKey a
pub} =
PublicKey a -> ByteString -> ByteString -> Bool
forall typ. PublicKey typ -> ByteString -> ByteString -> Bool
verify PublicKey a
pub ByteString
inp ByteString
sig
instance (Monad m, ToJSON m a) => ToJSON m (Signed a) where
toJSON :: Signed a -> m JSValue
toJSON Signed{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("signed" , a -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON a
signed)
, ("signatures" , Signatures -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Signatures
signatures)
]
instance Monad m => ToJSON m Signatures where
toJSON :: Signatures -> m JSValue
toJSON = [PreSignature] -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON ([PreSignature] -> m JSValue)
-> (Signatures -> [PreSignature]) -> Signatures -> m JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signatures -> [PreSignature]
toPreSignatures
instance MonadKeys m => FromJSON m Signatures where
fromJSON :: JSValue -> m Signatures
fromJSON = [PreSignature] -> m Signatures
forall (m :: * -> *). MonadKeys m => [PreSignature] -> m Signatures
fromPreSignatures ([PreSignature] -> m Signatures)
-> (JSValue -> m [PreSignature]) -> JSValue -> m Signatures
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSValue -> m [PreSignature]
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON
signedFromJSON :: (MonadKeys m, FromJSON m a) => JSValue -> m (Signed a)
signedFromJSON :: JSValue -> m (Signed a)
signedFromJSON envelope :: JSValue
envelope = do
JSValue
enc <- JSValue -> String -> m JSValue
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
envelope "signed"
a
signed <- JSValue -> m a
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc
Signatures
signatures <- JSValue -> String -> m Signatures
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
envelope "signatures"
String -> Bool -> m ()
forall (m :: * -> *).
MonadError DeserializationError m =>
String -> Bool -> m ()
validate "signatures" (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ JSValue -> Signatures -> Bool
verifySignatures JSValue
enc Signatures
signatures
Signed a -> m (Signed a)
forall (m :: * -> *) a. Monad m => a -> m a
return Signed :: forall a. a -> Signatures -> Signed a
Signed{..}
verifySignatures :: JSValue -> Signatures -> Bool
verifySignatures :: JSValue -> Signatures -> Bool
verifySignatures parsed :: JSValue
parsed (Signatures sigs :: [Signature]
sigs) =
(Signature -> Bool) -> [Signature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ByteString -> Signature -> Bool
verifySignature (ByteString -> Signature -> Bool)
-> ByteString -> Signature -> Bool
forall a b. (a -> b) -> a -> b
$ JSValue -> ByteString
renderCanonicalJSON JSValue
parsed) [Signature]
sigs
data UninterpretedSignatures a = UninterpretedSignatures {
UninterpretedSignatures a -> a
uninterpretedSigned :: a
, UninterpretedSignatures a -> [PreSignature]
uninterpretedSignatures :: [PreSignature]
}
deriving (Int -> UninterpretedSignatures a -> ShowS
[UninterpretedSignatures a] -> ShowS
UninterpretedSignatures a -> String
(Int -> UninterpretedSignatures a -> ShowS)
-> (UninterpretedSignatures a -> String)
-> ([UninterpretedSignatures a] -> ShowS)
-> Show (UninterpretedSignatures a)
forall a. Show a => Int -> UninterpretedSignatures a -> ShowS
forall a. Show a => [UninterpretedSignatures a] -> ShowS
forall a. Show a => UninterpretedSignatures a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UninterpretedSignatures a] -> ShowS
$cshowList :: forall a. Show a => [UninterpretedSignatures a] -> ShowS
show :: UninterpretedSignatures a -> String
$cshow :: forall a. Show a => UninterpretedSignatures a -> String
showsPrec :: Int -> UninterpretedSignatures a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> UninterpretedSignatures a -> ShowS
Show)
data PreSignature = PreSignature {
PreSignature -> ByteString
presignature :: BS.ByteString
, PreSignature -> Some KeyType
presigMethod :: Some KeyType
, PreSignature -> KeyId
presigKeyId :: KeyId
}
deriving (Int -> PreSignature -> ShowS
[PreSignature] -> ShowS
PreSignature -> String
(Int -> PreSignature -> ShowS)
-> (PreSignature -> String)
-> ([PreSignature] -> ShowS)
-> Show PreSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreSignature] -> ShowS
$cshowList :: [PreSignature] -> ShowS
show :: PreSignature -> String
$cshow :: PreSignature -> String
showsPrec :: Int -> PreSignature -> ShowS
$cshowsPrec :: Int -> PreSignature -> ShowS
Show)
fromPreSignature :: MonadKeys m => PreSignature -> m Signature
fromPreSignature :: PreSignature -> m Signature
fromPreSignature PreSignature{..} = do
Some PublicKey
key <- KeyId -> m (Some PublicKey)
forall (m :: * -> *). MonadKeys m => KeyId -> m (Some PublicKey)
lookupKey KeyId
presigKeyId
String -> Bool -> m ()
forall (m :: * -> *).
MonadError DeserializationError m =>
String -> Bool -> m ()
validate "key type" (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Some PublicKey -> Some (TypeOf PublicKey) -> Bool
forall (f :: * -> *). Typed f => Some f -> Some (TypeOf f) -> Bool
typecheckSome Some PublicKey
key Some (TypeOf PublicKey)
Some KeyType
presigMethod
Signature -> m Signature
forall (m :: * -> *) a. Monad m => a -> m a
return Signature :: ByteString -> Some PublicKey -> Signature
Signature {
signature :: ByteString
signature = ByteString
presignature
, signatureKey :: Some PublicKey
signatureKey = Some PublicKey
key
}
toPreSignature :: Signature -> PreSignature
toPreSignature :: Signature -> PreSignature
toPreSignature Signature{..} = PreSignature :: ByteString -> Some KeyType -> KeyId -> PreSignature
PreSignature {
presignature :: ByteString
presignature = ByteString
signature
, presigMethod :: Some KeyType
presigMethod = Some PublicKey -> Some KeyType
somePublicKeyType Some PublicKey
signatureKey
, presigKeyId :: KeyId
presigKeyId = Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
signatureKey
}
fromPreSignatures :: MonadKeys m => [PreSignature] -> m Signatures
fromPreSignatures :: [PreSignature] -> m Signatures
fromPreSignatures sigs :: [PreSignature]
sigs = do
String -> Bool -> m ()
forall (m :: * -> *).
MonadError DeserializationError m =>
String -> Bool -> m ()
validate "all signatures made with different keys" (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$
Set KeyId -> Int
forall a. Set a -> Int
Set.size ([KeyId] -> Set KeyId
forall a. Ord a => [a] -> Set a
Set.fromList ((PreSignature -> KeyId) -> [PreSignature] -> [KeyId]
forall a b. (a -> b) -> [a] -> [b]
map PreSignature -> KeyId
presigKeyId [PreSignature]
sigs)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [PreSignature] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PreSignature]
sigs
[Signature] -> Signatures
Signatures ([Signature] -> Signatures) -> m [Signature] -> m Signatures
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PreSignature -> m Signature) -> [PreSignature] -> m [Signature]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PreSignature -> m Signature
forall (m :: * -> *). MonadKeys m => PreSignature -> m Signature
fromPreSignature [PreSignature]
sigs
toPreSignatures :: Signatures -> [PreSignature]
toPreSignatures :: Signatures -> [PreSignature]
toPreSignatures (Signatures sigs :: [Signature]
sigs) = (Signature -> PreSignature) -> [Signature] -> [PreSignature]
forall a b. (a -> b) -> [a] -> [b]
map Signature -> PreSignature
toPreSignature [Signature]
sigs
instance ReportSchemaErrors m => FromJSON m PreSignature where
fromJSON :: JSValue -> m PreSignature
fromJSON enc :: JSValue
enc = do
String
kId <- JSValue -> String -> m String
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "keyid"
Some KeyType
method <- JSValue -> String -> m (Some KeyType)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "method"
Base64
sig <- JSValue -> String -> m Base64
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "sig"
PreSignature -> m PreSignature
forall (m :: * -> *) a. Monad m => a -> m a
return PreSignature :: ByteString -> Some KeyType -> KeyId -> PreSignature
PreSignature {
presignature :: ByteString
presignature = Base64 -> ByteString
B64.toByteString Base64
sig
, presigMethod :: Some KeyType
presigMethod = Some KeyType
method
, presigKeyId :: KeyId
presigKeyId = String -> KeyId
KeyId String
kId
}
instance Monad m => ToJSON m PreSignature where
toJSON :: PreSignature -> m JSValue
toJSON PreSignature{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("keyid" , JSValue -> m JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSValue -> m JSValue) -> JSValue -> m JSValue
forall a b. (a -> b) -> a -> b
$ String -> JSValue
JSString (String -> JSValue) -> (KeyId -> String) -> KeyId -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyId -> String
keyIdString (KeyId -> JSValue) -> KeyId -> JSValue
forall a b. (a -> b) -> a -> b
$ KeyId
presigKeyId)
, ("method" , Some KeyType -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (Some KeyType -> m JSValue) -> Some KeyType -> m JSValue
forall a b. (a -> b) -> a -> b
$ Some KeyType
presigMethod)
, ("sig" , Base64 -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (Base64 -> m JSValue) -> Base64 -> m JSValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Base64
B64.fromByteString ByteString
presignature)
]
instance ( ReportSchemaErrors m
, FromJSON m a
) => FromJSON m (UninterpretedSignatures a) where
fromJSON :: JSValue -> m (UninterpretedSignatures a)
fromJSON envelope :: JSValue
envelope = do
JSValue
enc <- JSValue -> String -> m JSValue
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
envelope "signed"
a
uninterpretedSigned <- JSValue -> m a
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc
[PreSignature]
uninterpretedSignatures <- JSValue -> String -> m [PreSignature]
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
envelope "signatures"
UninterpretedSignatures a -> m (UninterpretedSignatures a)
forall (m :: * -> *) a. Monad m => a -> m a
return UninterpretedSignatures :: forall a. a -> [PreSignature] -> UninterpretedSignatures a
UninterpretedSignatures{..}
instance (Monad m, ToJSON m a) => ToJSON m (UninterpretedSignatures a) where
toJSON :: UninterpretedSignatures a -> m JSValue
toJSON UninterpretedSignatures{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("signed" , a -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON a
uninterpretedSigned)
, ("signatures" , [PreSignature] -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON [PreSignature]
uninterpretedSignatures)
]