    -- | Wrapper around an arbitrary datatype that adds signatures
    --
    -- Note that in the spec there is explicit sharing of keys through key IDs;
    -- we translate this to implicit sharing in our Haskell datatypes, with the
    -- translation done in the JSON serialization/deserialization.
    module Hackage.Security.TUF.Signed (
        -- * TUF types
        Signed(..)
      , Signatures(..)
      , Signature(..)
        -- * Construction and verification
      , unsigned
      , withSignatures
      , withSignatures'
      , signRendered
      , verifySignature
        -- * JSON aids
      , signedFromJSON
      , verifySignatures
        -- * Avoid interpreting signatures
      , UninterpretedSignatures(..)
      , PreSignature(..)
        -- ** Utility
      , fromPreSignature
      , fromPreSignatures
      , toPreSignature
      , toPreSignatures
      ) where

    import Prelude
    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

    {-------------------------------------------------------------------------------
      Signed objects
    -------------------------------------------------------------------------------}

    data Signed a = Signed {
        forall a. Signed a -> a
    signed     :: a
      , forall a. Signed a -> Signatures
    signatures :: Signatures
      }

    -- | A list of signatures
    --
    -- Invariant: each signature must be made with a different key.
    -- We enforce this invariant for incoming untrusted data ('fromPreSignatures')
    -- but not for lists of signatures that we create in code.
    newtype Signatures = Signatures [Signature]

    data Signature = Signature {
        Signature -> ByteString
    signature    :: BS.ByteString
      , Signature -> Some PublicKey
    signatureKey :: Some PublicKey
      }

    -- | Create a new document without any signatures
    unsigned :: a -> Signed a
    unsigned :: forall a. a -> Signed a
    unsigned a
    a = Signed { signed :: a
    signed = a
    a, signatures :: Signatures
    signatures = [Signature] -> Signatures
    Signatures [] }

    -- | Sign a document
    withSignatures :: ToJSON WriteJSON a => RepoLayout -> [Some Key] -> a -> Signed a
    withSignatures :: forall a.
    ToJSON WriteJSON a =>
    RepoLayout -> [Some Key] -> a -> Signed a
    withSignatures RepoLayout
    repoLayout [Some Key]
    keys a
    doc = 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
        }

    -- | Variation on 'withSignatures' that doesn't need the repo layout
    withSignatures' :: ToJSON Identity a => [Some Key] -> a -> Signed a
    withSignatures' :: forall a. ToJSON Identity a => [Some Key] -> a -> Signed a
    withSignatures' [Some Key]
    keys a
    doc = 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
        }

    -- | Construct signatures for already rendered value
    signRendered :: [Some Key] -> BS.L.ByteString -> Signatures
    signRendered :: [Some Key] -> ByteString -> Signatures
    signRendered [Some Key]
    keys 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 a
    key) = 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 ByteString
    inp Signature{signature :: Signature -> ByteString
    signature = ByteString
    sig, signatureKey :: Signature -> Some PublicKey
    signatureKey = Some 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{a
    Signatures
    signed :: forall a. Signed a -> a
    signatures :: forall a. Signed a -> Signatures
    signed :: a
    signatures :: Signatures
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
             (String
    "signed"     , a -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON a
    signed)
           , (String
    "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

    {-------------------------------------------------------------------------------
      JSON aids
    -------------------------------------------------------------------------------}

    -- | General FromJSON instance for signed datatypes
    --
    -- We don't give a general FromJSON instance for Signed because for some
    -- datatypes we need to do something special (datatypes where we need to
    -- read key environments); for instance, see the "Signed Root" instance.
    signedFromJSON :: (MonadKeys m, FromJSON m a) => JSValue -> m (Signed a)
    signedFromJSON :: forall (m :: * -> *) a.
    (MonadKeys m, FromJSON m a) =>
    JSValue -> m (Signed a)
    signedFromJSON JSValue
    envelope = do
        enc        <- JSValue -> String -> m JSValue
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    envelope String
    "signed"
        signed     <- fromJSON enc
        signatures <- fromJSField envelope "signatures"
        validate "signatures" $ verifySignatures enc signatures
        return Signed{..}

    -- | Signature verification
    --
    -- NOTES:
    -- 1. By definition, the signature must be verified against the canonical
    --    JSON format. This means we _must_ parse and then pretty print (as
    --    we do here) because the document as stored may or may not be in
    --    canonical format.
    -- 2. However, it is important that we NOT translate from the JSValue
    --    to whatever internal datatype we are using and then back to JSValue,
    --    because that may not roundtrip: we must allow for additional fields
    --    in the JSValue that we ignore (and would therefore lose when we
    --    attempt to roundtrip).
    -- 3. We verify that all signatures are valid, but we cannot verify (here)
    --    that these signatures are signed with the right key, or that we
    --    have a sufficient number of signatures. This will be the
    --    responsibility of the calling code.
    verifySignatures :: JSValue -> Signatures -> Bool
    verifySignatures :: JSValue -> Signatures -> Bool
    verifySignatures JSValue
    parsed (Signatures [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

    {-------------------------------------------------------------------------------
      Uninterpreted signatures
    -------------------------------------------------------------------------------}

    -- | File with uninterpreted signatures
    --
    -- Sometimes we want to be able to read a file without interpreting the
    -- signatures (that is, resolving the key IDs) or doing any kind of checks on
    -- them. One advantage of this is that this allows us to read many file types
    -- without any key environment at all, which is sometimes useful.
    data UninterpretedSignatures a = UninterpretedSignatures {
        forall a. UninterpretedSignatures a -> a
    uninterpretedSigned     :: a
      , forall 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
    $cshowsPrec :: forall a. Show a => Int -> UninterpretedSignatures a -> ShowS
    showsPrec :: Int -> UninterpretedSignatures a -> ShowS
    $cshow :: forall a. Show a => UninterpretedSignatures a -> String
    show :: UninterpretedSignatures a -> String
    $cshowList :: forall a. Show a => [UninterpretedSignatures a] -> ShowS
    showList :: [UninterpretedSignatures a] -> ShowS
    Show)

    -- | A signature with a key ID (rather than an actual key)
    --
    -- This corresponds precisely to the TUF representation of a signature.
    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
    $cshowsPrec :: Int -> PreSignature -> ShowS
    showsPrec :: Int -> PreSignature -> ShowS
    $cshow :: PreSignature -> String
    show :: PreSignature -> String
    $cshowList :: [PreSignature] -> ShowS
    showList :: [PreSignature] -> ShowS
    Show)

    -- | Convert a pre-signature to a signature
    --
    -- Verifies that the key type matches the advertised method.
    fromPreSignature :: MonadKeys m => PreSignature -> m Signature
    fromPreSignature :: forall (m :: * -> *). MonadKeys m => PreSignature -> m Signature
    fromPreSignature PreSignature{ByteString
    Some KeyType
    KeyId
    presignature :: PreSignature -> ByteString
    presigMethod :: PreSignature -> Some KeyType
    presigKeyId :: PreSignature -> KeyId
    presignature :: ByteString
    presigMethod :: Some KeyType
    presigKeyId :: KeyId
    ..} = do
        key <- KeyId -> m (Some PublicKey)
    forall (m :: * -> *). MonadKeys m => KeyId -> m (Some PublicKey)
    lookupKey KeyId
    presigKeyId
        validate "key type" $ typecheckSome key presigMethod
        return Signature {
            signature    = presignature
          , signatureKey = key
          }

    -- | Convert signature to pre-signature
    toPreSignature :: Signature -> PreSignature
    toPreSignature :: Signature -> PreSignature
    toPreSignature Signature{ByteString
    Some PublicKey
    signature :: Signature -> ByteString
    signatureKey :: Signature -> Some PublicKey
    signature :: ByteString
    signatureKey :: Some PublicKey
    ..} = 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
        }

    -- | Convert a list of 'PreSignature's to a list of 'Signature's
    --
    -- This verifies the invariant that all signatures are made with different keys.
    -- We do this on the presignatures rather than the signatures so that we can do
    -- the check on key IDs, rather than keys (the latter don't have an Ord
    -- instance).
    fromPreSignatures :: MonadKeys m => [PreSignature] -> m Signatures
    fromPreSignatures :: forall (m :: * -> *). MonadKeys m => [PreSignature] -> m Signatures
    fromPreSignatures [PreSignature]
    sigs = do
          String -> Bool -> m ()
    forall (m :: * -> *).
    MonadError DeserializationError m =>
    String -> Bool -> m ()
    validate String
    "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 a. [a] -> 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM PreSignature -> m Signature
    forall (m :: * -> *). MonadKeys m => PreSignature -> m Signature
    fromPreSignature [PreSignature]
    sigs

    -- | Convert list of pre-signatures to a list of signatures
    toPreSignatures :: Signatures -> [PreSignature]
    toPreSignatures :: Signatures -> [PreSignature]
    toPreSignatures (Signatures [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 JSValue
    enc = do
        kId    <- JSValue -> String -> m String
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    enc String
    "keyid"
        method <- fromJSField enc "method"
        sig    <- fromJSField enc "sig"
        return PreSignature {
            presignature = B64.toByteString sig
          , presigMethod = method
          , presigKeyId  = KeyId kId
          }

    instance Monad m => ToJSON m PreSignature where
      toJSON :: PreSignature -> m JSValue
    toJSON PreSignature{ByteString
    Some KeyType
    KeyId
    presignature :: PreSignature -> ByteString
    presigMethod :: PreSignature -> Some KeyType
    presigKeyId :: PreSignature -> KeyId
    presignature :: ByteString
    presigMethod :: Some KeyType
    presigKeyId :: KeyId
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
             (String
    "keyid"  , JSValue -> m JSValue
    forall a. a -> m a
    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)
           , (String
    "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)
           , (String
    "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 JSValue
    envelope = do
        enc <- JSValue -> String -> m JSValue
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    envelope String
    "signed"
        uninterpretedSigned     <- fromJSON enc
        uninterpretedSignatures <- fromJSField envelope "signatures"
        return UninterpretedSignatures{..}

    instance (Monad m, ToJSON m a) => ToJSON m (UninterpretedSignatures a) where
      toJSON :: UninterpretedSignatures a -> m JSValue
    toJSON UninterpretedSignatures{a
    [PreSignature]
    uninterpretedSigned :: forall a. UninterpretedSignatures a -> a
    uninterpretedSignatures :: forall a. UninterpretedSignatures a -> [PreSignature]
    uninterpretedSigned :: a
    uninterpretedSignatures :: [PreSignature]
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
             (String
    "signed"     , a -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON a
    uninterpretedSigned)
           , (String
    "signatures" , [PreSignature] -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON [PreSignature]
    uninterpretedSignatures)
           ]