module Hackage.Security.Key.Env (
    KeyEnv -- opaque
  , keyEnvMap
    -- * Convenience constructors
  , fromPublicKeys
  , fromKeys
    -- * The usual accessors
  , empty
  , null
  , insert
  , lookup
  , union
  ) where

import MyPrelude hiding (lookup, null)
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map

import Hackage.Security.Key
import Hackage.Security.Util.JSON
import Hackage.Security.Util.Some

{-------------------------------------------------------------------------------
  Main datatype
-------------------------------------------------------------------------------}

-- | A key environment is a mapping from key IDs to the corresponding keys.
--
-- It should satisfy the invariant that these key IDs actually match the keys;
-- see 'checkKeyEnvInvariant'.
newtype KeyEnv = KeyEnv {
    KeyEnv -> Map KeyId (Some PublicKey)
keyEnvMap :: Map KeyId (Some PublicKey)
  }
  deriving (Int -> KeyEnv -> ShowS
[KeyEnv] -> ShowS
KeyEnv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyEnv] -> ShowS
$cshowList :: [KeyEnv] -> ShowS
show :: KeyEnv -> String
$cshow :: KeyEnv -> String
showsPrec :: Int -> KeyEnv -> ShowS
$cshowsPrec :: Int -> KeyEnv -> ShowS
Show)

-- | Verify that each key ID is mapped to a key with that ID
checkKeyEnvInvariant :: KeyEnv -> Bool
checkKeyEnvInvariant :: KeyEnv -> Bool
checkKeyEnvInvariant = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry KeyId -> Some PublicKey -> Bool
go) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyEnv -> Map KeyId (Some PublicKey)
keyEnvMap
  where
    go :: KeyId -> Some PublicKey -> Bool
    go :: KeyId -> Some PublicKey -> Bool
go KeyId
kId Some PublicKey
key = KeyId
kId forall a. Eq a => a -> a -> Bool
== forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
key

{-------------------------------------------------------------------------------
  Convenience constructors
-------------------------------------------------------------------------------}

fromPublicKeys :: [Some PublicKey] -> KeyEnv
fromPublicKeys :: [Some PublicKey] -> KeyEnv
fromPublicKeys = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Some PublicKey -> (KeyId, Some PublicKey)
aux
  where
    aux :: Some PublicKey -> (KeyId, Some PublicKey)
    aux :: Some PublicKey -> (KeyId, Some PublicKey)
aux Some PublicKey
pub = (forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
pub, Some PublicKey
pub)

fromKeys :: [Some Key] -> KeyEnv
fromKeys :: [Some Key] -> KeyEnv
fromKeys = [Some PublicKey] -> KeyEnv
fromPublicKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Some Key -> Some PublicKey
somePublicKey

{-------------------------------------------------------------------------------
  The usual accessors
-------------------------------------------------------------------------------}

empty :: KeyEnv
empty :: KeyEnv
empty = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv forall k a. Map k a
Map.empty

null :: KeyEnv -> Bool
null :: KeyEnv -> Bool
null (KeyEnv Map KeyId (Some PublicKey)
env) = forall k a. Map k a -> Bool
Map.null Map KeyId (Some PublicKey)
env

insert :: Some PublicKey -> KeyEnv -> KeyEnv
insert :: Some PublicKey -> KeyEnv -> KeyEnv
insert Some PublicKey
key (KeyEnv Map KeyId (Some PublicKey)
env) = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
key) Some PublicKey
key Map KeyId (Some PublicKey)
env

lookup :: KeyId -> KeyEnv -> Maybe (Some PublicKey)
lookup :: KeyId -> KeyEnv -> Maybe (Some PublicKey)
lookup KeyId
kId (KeyEnv Map KeyId (Some PublicKey)
env) = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyId
kId Map KeyId (Some PublicKey)
env

union :: KeyEnv -> KeyEnv -> KeyEnv
union :: KeyEnv -> KeyEnv -> KeyEnv
union (KeyEnv Map KeyId (Some PublicKey)
env) (KeyEnv Map KeyId (Some PublicKey)
env') = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv (Map KeyId (Some PublicKey)
env forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map KeyId (Some PublicKey)
env')

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

instance Monad m => ToJSON m KeyEnv where
  toJSON :: KeyEnv -> m JSValue
toJSON (KeyEnv Map KeyId (Some PublicKey)
keyEnv) = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Map KeyId (Some PublicKey)
keyEnv

instance ReportSchemaErrors m => FromJSON m KeyEnv where
  fromJSON :: JSValue -> m KeyEnv
fromJSON JSValue
enc = do
    KeyEnv
keyEnv <- Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc
    -- We should really use 'validate', but that causes module import cycles.
    -- Sigh.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyEnv -> Bool
checkKeyEnvInvariant KeyEnv
keyEnv) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a.
ReportSchemaErrors m =>
String -> Maybe String -> m a
expected String
"valid key environment" forall a. Maybe a
Nothing
    forall (m :: * -> *) a. Monad m => a -> m a
return KeyEnv
keyEnv