-- | Simple type wrappers
module Hackage.Security.TUF.Common (
    -- * Types
    FileLength(..)
  , Hash(..)
  , KeyThreshold(..)
  ) where

import MyPrelude
import Hackage.Security.JSON

{-------------------------------------------------------------------------------
  Simple types
-------------------------------------------------------------------------------}

-- | File length
--
-- Having verified file length information means we can protect against
-- endless data attacks and similar.
newtype FileLength = FileLength { FileLength -> Int54
fileLength :: Int54 }
  deriving (FileLength -> FileLength -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileLength -> FileLength -> Bool
$c/= :: FileLength -> FileLength -> Bool
== :: FileLength -> FileLength -> Bool
$c== :: FileLength -> FileLength -> Bool
Eq, Eq FileLength
FileLength -> FileLength -> Bool
FileLength -> FileLength -> Ordering
FileLength -> FileLength -> FileLength
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileLength -> FileLength -> FileLength
$cmin :: FileLength -> FileLength -> FileLength
max :: FileLength -> FileLength -> FileLength
$cmax :: FileLength -> FileLength -> FileLength
>= :: FileLength -> FileLength -> Bool
$c>= :: FileLength -> FileLength -> Bool
> :: FileLength -> FileLength -> Bool
$c> :: FileLength -> FileLength -> Bool
<= :: FileLength -> FileLength -> Bool
$c<= :: FileLength -> FileLength -> Bool
< :: FileLength -> FileLength -> Bool
$c< :: FileLength -> FileLength -> Bool
compare :: FileLength -> FileLength -> Ordering
$ccompare :: FileLength -> FileLength -> Ordering
Ord, Int -> FileLength -> ShowS
[FileLength] -> ShowS
FileLength -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileLength] -> ShowS
$cshowList :: [FileLength] -> ShowS
show :: FileLength -> String
$cshow :: FileLength -> String
showsPrec :: Int -> FileLength -> ShowS
$cshowsPrec :: Int -> FileLength -> ShowS
Show)

-- | Key threshold
--
-- The key threshold is the minimum number of keys a document must be signed
-- with. Key thresholds are specified in 'RoleSpec' or 'DelegationsSpec'.
newtype KeyThreshold = KeyThreshold Int54
  deriving (KeyThreshold -> KeyThreshold -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyThreshold -> KeyThreshold -> Bool
$c/= :: KeyThreshold -> KeyThreshold -> Bool
== :: KeyThreshold -> KeyThreshold -> Bool
$c== :: KeyThreshold -> KeyThreshold -> Bool
Eq, Eq KeyThreshold
KeyThreshold -> KeyThreshold -> Bool
KeyThreshold -> KeyThreshold -> Ordering
KeyThreshold -> KeyThreshold -> KeyThreshold
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyThreshold -> KeyThreshold -> KeyThreshold
$cmin :: KeyThreshold -> KeyThreshold -> KeyThreshold
max :: KeyThreshold -> KeyThreshold -> KeyThreshold
$cmax :: KeyThreshold -> KeyThreshold -> KeyThreshold
>= :: KeyThreshold -> KeyThreshold -> Bool
$c>= :: KeyThreshold -> KeyThreshold -> Bool
> :: KeyThreshold -> KeyThreshold -> Bool
$c> :: KeyThreshold -> KeyThreshold -> Bool
<= :: KeyThreshold -> KeyThreshold -> Bool
$c<= :: KeyThreshold -> KeyThreshold -> Bool
< :: KeyThreshold -> KeyThreshold -> Bool
$c< :: KeyThreshold -> KeyThreshold -> Bool
compare :: KeyThreshold -> KeyThreshold -> Ordering
$ccompare :: KeyThreshold -> KeyThreshold -> Ordering
Ord, Int -> KeyThreshold -> ShowS
[KeyThreshold] -> ShowS
KeyThreshold -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyThreshold] -> ShowS
$cshowList :: [KeyThreshold] -> ShowS
show :: KeyThreshold -> String
$cshow :: KeyThreshold -> String
showsPrec :: Int -> KeyThreshold -> ShowS
$cshowsPrec :: Int -> KeyThreshold -> ShowS
Show)

-- | File hash
newtype Hash = Hash String
  deriving (Hash -> Hash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c== :: Hash -> Hash -> Bool
Eq, Eq Hash
Hash -> Hash -> Bool
Hash -> Hash -> Ordering
Hash -> Hash -> Hash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hash -> Hash -> Hash
$cmin :: Hash -> Hash -> Hash
max :: Hash -> Hash -> Hash
$cmax :: Hash -> Hash -> Hash
>= :: Hash -> Hash -> Bool
$c>= :: Hash -> Hash -> Bool
> :: Hash -> Hash -> Bool
$c> :: Hash -> Hash -> Bool
<= :: Hash -> Hash -> Bool
$c<= :: Hash -> Hash -> Bool
< :: Hash -> Hash -> Bool
$c< :: Hash -> Hash -> Bool
compare :: Hash -> Hash -> Ordering
$ccompare :: Hash -> Hash -> Ordering
Ord, Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show)

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

instance Monad m => ToJSON m KeyThreshold where
  toJSON :: KeyThreshold -> m JSValue
toJSON (KeyThreshold Int54
i) = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Int54
i

instance Monad m => ToJSON m FileLength where
  toJSON :: FileLength -> m JSValue
toJSON (FileLength Int54
i) = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Int54
i

instance Monad m => ToJSON m Hash where
  toJSON :: Hash -> m JSValue
toJSON (Hash String
str) = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON String
str

instance ReportSchemaErrors m => FromJSON m KeyThreshold where
  fromJSON :: JSValue -> m KeyThreshold
fromJSON JSValue
enc = Int54 -> KeyThreshold
KeyThreshold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc

instance ReportSchemaErrors m => FromJSON m FileLength where
  fromJSON :: JSValue -> m FileLength
fromJSON JSValue
enc = Int54 -> FileLength
FileLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc

instance ReportSchemaErrors m => FromJSON m Hash where
  fromJSON :: JSValue -> m Hash
fromJSON JSValue
enc = String -> Hash
Hash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc