{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.MLS.CipherSuite
  ( -- * MLS ciphersuites
    CipherSuite (..),
    defCipherSuite,
    CipherSuiteTag (..),
    cipherSuiteTag,
    tagCipherSuite,

    -- * MLS signature schemes
    SignatureScheme (..),
    IsSignatureScheme,
    SignatureSchemeTag (..),
    SignatureSchemeCurve,
    signatureSchemeName,
    csSignatureScheme,

    -- * Key pairs
    KeyPair,

    -- * Utilities
    csHash,
    csVerifySignatureWithLabel,
    csVerifySignature,
    signWithLabel,
  )
where

import Cassandra qualified as C
import Cassandra.CQL
import Control.Applicative
import Control.Error (note)
import Control.Lens ((?~))
import Crypto.ECC hiding (KeyPair)
import Crypto.Error
import Crypto.Hash (hashWith)
import Crypto.Hash.Algorithms
import Crypto.PubKey.ECDSA qualified as ECDSA
import Crypto.PubKey.Ed25519 qualified as Ed25519
import Crypto.Random.Types
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
import Data.Aeson.Types qualified as Aeson
import Data.Attoparsec.ByteString.Char8 qualified as Atto
import Data.Bifunctor
import Data.ByteArray hiding (index)
import Data.ByteArray qualified as BA
import Data.ByteString.Conversion
import Data.OpenApi qualified as S
import Data.OpenApi.Internal.Schema qualified as S
import Data.Proxy
import Data.Schema
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Builder qualified as LT
import Data.Text.Lazy.Builder.Int qualified as LT
import Data.Word
import Imports
import Web.HttpApiData
import Wire.API.MLS.ECDSA qualified as ECDSA
import Wire.API.MLS.Serialisation
import Wire.Arbitrary

newtype CipherSuite = CipherSuite {CipherSuite -> Word16
cipherSuiteNumber :: Word16}
  deriving stock (CipherSuite -> CipherSuite -> Bool
(CipherSuite -> CipherSuite -> Bool)
-> (CipherSuite -> CipherSuite -> Bool) -> Eq CipherSuite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherSuite -> CipherSuite -> Bool
== :: CipherSuite -> CipherSuite -> Bool
$c/= :: CipherSuite -> CipherSuite -> Bool
/= :: CipherSuite -> CipherSuite -> Bool
Eq, Int -> CipherSuite -> ShowS
[CipherSuite] -> ShowS
CipherSuite -> String
(Int -> CipherSuite -> ShowS)
-> (CipherSuite -> String)
-> ([CipherSuite] -> ShowS)
-> Show CipherSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherSuite -> ShowS
showsPrec :: Int -> CipherSuite -> ShowS
$cshow :: CipherSuite -> String
show :: CipherSuite -> String
$cshowList :: [CipherSuite] -> ShowS
showList :: [CipherSuite] -> ShowS
Show)
  deriving newtype (Get CipherSuite
Get CipherSuite -> ParseMLS CipherSuite
forall a. Get a -> ParseMLS a
$cparseMLS :: Get CipherSuite
parseMLS :: Get CipherSuite
ParseMLS, CipherSuite -> Put
(CipherSuite -> Put) -> SerialiseMLS CipherSuite
forall a. (a -> Put) -> SerialiseMLS a
$cserialiseMLS :: CipherSuite -> Put
serialiseMLS :: CipherSuite -> Put
SerialiseMLS, Gen CipherSuite
Gen CipherSuite
-> (CipherSuite -> [CipherSuite]) -> Arbitrary CipherSuite
CipherSuite -> [CipherSuite]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CipherSuite
arbitrary :: Gen CipherSuite
$cshrink :: CipherSuite -> [CipherSuite]
shrink :: CipherSuite -> [CipherSuite]
Arbitrary)
  deriving (Value -> Parser [CipherSuite]
Value -> Parser CipherSuite
(Value -> Parser CipherSuite)
-> (Value -> Parser [CipherSuite]) -> FromJSON CipherSuite
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CipherSuite
parseJSON :: Value -> Parser CipherSuite
$cparseJSONList :: Value -> Parser [CipherSuite]
parseJSONList :: Value -> Parser [CipherSuite]
FromJSON, [CipherSuite] -> Value
[CipherSuite] -> Encoding
CipherSuite -> Value
CipherSuite -> Encoding
(CipherSuite -> Value)
-> (CipherSuite -> Encoding)
-> ([CipherSuite] -> Value)
-> ([CipherSuite] -> Encoding)
-> ToJSON CipherSuite
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CipherSuite -> Value
toJSON :: CipherSuite -> Value
$ctoEncoding :: CipherSuite -> Encoding
toEncoding :: CipherSuite -> Encoding
$ctoJSONList :: [CipherSuite] -> Value
toJSONList :: [CipherSuite] -> Value
$ctoEncodingList :: [CipherSuite] -> Encoding
toEncodingList :: [CipherSuite] -> Encoding
ToJSON, Typeable CipherSuite
Typeable CipherSuite =>
(Proxy CipherSuite -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CipherSuite
Proxy CipherSuite -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CipherSuite -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CipherSuite -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CipherSuite

instance ToSchema CipherSuite where
  schema :: ValueSchema NamedSwaggerDoc CipherSuite
schema =
    Text
-> SchemaP SwaggerDoc Value Value CipherSuite CipherSuite
-> ValueSchema NamedSwaggerDoc CipherSuite
forall doc doc' v m a b.
HasObject doc doc' =>
Text -> SchemaP doc v m a b -> SchemaP doc' v m a b
named Text
"CipherSuite" (SchemaP SwaggerDoc Value Value CipherSuite CipherSuite
 -> ValueSchema NamedSwaggerDoc CipherSuite)
-> SchemaP SwaggerDoc Value Value CipherSuite CipherSuite
-> ValueSchema NamedSwaggerDoc CipherSuite
forall a b. (a -> b) -> a -> b
$
      CipherSuite -> Word16
cipherSuiteNumber (CipherSuite -> Word16)
-> SchemaP SwaggerDoc Value Value Word16 CipherSuite
-> SchemaP SwaggerDoc Value Value CipherSuite CipherSuite
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Word16 -> CipherSuite)
-> SchemaP SwaggerDoc Value Value Word16 Word16
-> SchemaP SwaggerDoc Value Value Word16 CipherSuite
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Value Value Word16 a
-> SchemaP SwaggerDoc Value Value Word16 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> CipherSuite
CipherSuite (SchemaP NamedSwaggerDoc Value Value Word16 Word16
-> SchemaP SwaggerDoc Value Value Word16 Word16
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value Word16 Word16
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance S.ToParamSchema CipherSuite where
  toParamSchema :: Proxy CipherSuite -> Schema
toParamSchema Proxy CipherSuite
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiNumber

instance FromHttpApiData CipherSuite where
  parseUrlPiece :: Text -> Either Text CipherSuite
parseUrlPiece = ByteString -> Either Text CipherSuite
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text CipherSuite)
-> (Text -> ByteString) -> Text -> Either Text CipherSuite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
  parseHeader :: ByteString -> Either Text CipherSuite
parseHeader = (String -> Text)
-> Either String CipherSuite -> Either Text CipherSuite
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String CipherSuite -> Either Text CipherSuite)
-> (ByteString -> Either String CipherSuite)
-> ByteString
-> Either Text CipherSuite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser CipherSuite -> ByteString -> Either String CipherSuite
forall a. Parser a -> ByteString -> Either String a
runParser Parser CipherSuite
forall a. FromByteString a => Parser a
parser

instance ToHttpApiData CipherSuite where
  toUrlPiece :: CipherSuite -> Text
toUrlPiece =
    Text -> Text
LT.toStrict
      (Text -> Text) -> (CipherSuite -> Text) -> CipherSuite -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LT.toLazyText
      (Builder -> Text)
-> (CipherSuite -> Builder) -> CipherSuite -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"0x" <>)
      (Builder -> Builder)
-> (CipherSuite -> Builder) -> CipherSuite -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
forall a. Integral a => a -> Builder
LT.hexadecimal
      (Word16 -> Builder)
-> (CipherSuite -> Word16) -> CipherSuite -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherSuite -> Word16
cipherSuiteNumber

instance FromByteString CipherSuite where
  parser :: Parser CipherSuite
parser = do
    Parser ByteString (Maybe ByteString) -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString (Maybe ByteString) -> Parser ByteString ())
-> Parser ByteString (Maybe ByteString) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall i a. Parser i a -> Parser i a
Atto.try (Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByteString -> Parser ByteString ByteString
Atto.string ByteString
"0x"))
    Word16 -> CipherSuite
CipherSuite (Word16 -> CipherSuite)
-> Parser ByteString Word16 -> Parser CipherSuite
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
Atto.hexadecimal

data CipherSuiteTag
  = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
  | MLS_128_DHKEMP256_AES128GCM_SHA256_P256
  | MLS_256_DHKEMP384_AES256GCM_SHA384_P384
  | MLS_256_DHKEMP521_AES256GCM_SHA512_P521
  | MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519
  deriving stock (CipherSuiteTag
CipherSuiteTag -> CipherSuiteTag -> Bounded CipherSuiteTag
forall a. a -> a -> Bounded a
$cminBound :: CipherSuiteTag
minBound :: CipherSuiteTag
$cmaxBound :: CipherSuiteTag
maxBound :: CipherSuiteTag
Bounded, Int -> CipherSuiteTag
CipherSuiteTag -> Int
CipherSuiteTag -> [CipherSuiteTag]
CipherSuiteTag -> CipherSuiteTag
CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
CipherSuiteTag
-> CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
(CipherSuiteTag -> CipherSuiteTag)
-> (CipherSuiteTag -> CipherSuiteTag)
-> (Int -> CipherSuiteTag)
-> (CipherSuiteTag -> Int)
-> (CipherSuiteTag -> [CipherSuiteTag])
-> (CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag])
-> (CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag])
-> (CipherSuiteTag
    -> CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag])
-> Enum CipherSuiteTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CipherSuiteTag -> CipherSuiteTag
succ :: CipherSuiteTag -> CipherSuiteTag
$cpred :: CipherSuiteTag -> CipherSuiteTag
pred :: CipherSuiteTag -> CipherSuiteTag
$ctoEnum :: Int -> CipherSuiteTag
toEnum :: Int -> CipherSuiteTag
$cfromEnum :: CipherSuiteTag -> Int
fromEnum :: CipherSuiteTag -> Int
$cenumFrom :: CipherSuiteTag -> [CipherSuiteTag]
enumFrom :: CipherSuiteTag -> [CipherSuiteTag]
$cenumFromThen :: CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
enumFromThen :: CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
$cenumFromTo :: CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
enumFromTo :: CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
$cenumFromThenTo :: CipherSuiteTag
-> CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
enumFromThenTo :: CipherSuiteTag
-> CipherSuiteTag -> CipherSuiteTag -> [CipherSuiteTag]
Enum, CipherSuiteTag -> CipherSuiteTag -> Bool
(CipherSuiteTag -> CipherSuiteTag -> Bool)
-> (CipherSuiteTag -> CipherSuiteTag -> Bool) -> Eq CipherSuiteTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherSuiteTag -> CipherSuiteTag -> Bool
== :: CipherSuiteTag -> CipherSuiteTag -> Bool
$c/= :: CipherSuiteTag -> CipherSuiteTag -> Bool
/= :: CipherSuiteTag -> CipherSuiteTag -> Bool
Eq, Int -> CipherSuiteTag -> ShowS
[CipherSuiteTag] -> ShowS
CipherSuiteTag -> String
(Int -> CipherSuiteTag -> ShowS)
-> (CipherSuiteTag -> String)
-> ([CipherSuiteTag] -> ShowS)
-> Show CipherSuiteTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherSuiteTag -> ShowS
showsPrec :: Int -> CipherSuiteTag -> ShowS
$cshow :: CipherSuiteTag -> String
show :: CipherSuiteTag -> String
$cshowList :: [CipherSuiteTag] -> ShowS
showList :: [CipherSuiteTag] -> ShowS
Show, (forall x. CipherSuiteTag -> Rep CipherSuiteTag x)
-> (forall x. Rep CipherSuiteTag x -> CipherSuiteTag)
-> Generic CipherSuiteTag
forall x. Rep CipherSuiteTag x -> CipherSuiteTag
forall x. CipherSuiteTag -> Rep CipherSuiteTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CipherSuiteTag -> Rep CipherSuiteTag x
from :: forall x. CipherSuiteTag -> Rep CipherSuiteTag x
$cto :: forall x. Rep CipherSuiteTag x -> CipherSuiteTag
to :: forall x. Rep CipherSuiteTag x -> CipherSuiteTag
Generic, Eq CipherSuiteTag
Eq CipherSuiteTag =>
(CipherSuiteTag -> CipherSuiteTag -> Ordering)
-> (CipherSuiteTag -> CipherSuiteTag -> Bool)
-> (CipherSuiteTag -> CipherSuiteTag -> Bool)
-> (CipherSuiteTag -> CipherSuiteTag -> Bool)
-> (CipherSuiteTag -> CipherSuiteTag -> Bool)
-> (CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag)
-> (CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag)
-> Ord CipherSuiteTag
CipherSuiteTag -> CipherSuiteTag -> Bool
CipherSuiteTag -> CipherSuiteTag -> Ordering
CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag
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
$ccompare :: CipherSuiteTag -> CipherSuiteTag -> Ordering
compare :: CipherSuiteTag -> CipherSuiteTag -> Ordering
$c< :: CipherSuiteTag -> CipherSuiteTag -> Bool
< :: CipherSuiteTag -> CipherSuiteTag -> Bool
$c<= :: CipherSuiteTag -> CipherSuiteTag -> Bool
<= :: CipherSuiteTag -> CipherSuiteTag -> Bool
$c> :: CipherSuiteTag -> CipherSuiteTag -> Bool
> :: CipherSuiteTag -> CipherSuiteTag -> Bool
$c>= :: CipherSuiteTag -> CipherSuiteTag -> Bool
>= :: CipherSuiteTag -> CipherSuiteTag -> Bool
$cmax :: CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag
max :: CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag
$cmin :: CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag
min :: CipherSuiteTag -> CipherSuiteTag -> CipherSuiteTag
Ord)
  deriving (Gen CipherSuiteTag
Gen CipherSuiteTag
-> (CipherSuiteTag -> [CipherSuiteTag]) -> Arbitrary CipherSuiteTag
CipherSuiteTag -> [CipherSuiteTag]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CipherSuiteTag
arbitrary :: Gen CipherSuiteTag
$cshrink :: CipherSuiteTag -> [CipherSuiteTag]
shrink :: CipherSuiteTag -> [CipherSuiteTag]
Arbitrary) via (GenericUniform CipherSuiteTag)

defCipherSuite :: CipherSuiteTag
defCipherSuite :: CipherSuiteTag
defCipherSuite = CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519

instance S.ToSchema CipherSuiteTag where
  declareNamedSchema :: Proxy CipherSuiteTag -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CipherSuiteTag
_ =
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> NamedSchema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Schema -> NamedSchema
S.named Text
"CipherSuiteTag" (Schema -> Declare (Definitions Schema) NamedSchema)
-> Schema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      ( Proxy Word16 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
S.paramSchemaToSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Word16)
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Index number of ciphersuite. See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5"
      )

instance ToSchema CipherSuiteTag where
  schema :: ValueSchema NamedSwaggerDoc CipherSuiteTag
schema =
    NamedSwaggerDoc
-> (Value -> Parser CipherSuiteTag)
-> (CipherSuiteTag -> Maybe Value)
-> ValueSchema NamedSwaggerDoc CipherSuiteTag
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema
      (forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @CipherSuiteTag)
      Value -> Parser CipherSuiteTag
tagParser
      (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (CipherSuiteTag -> Value) -> CipherSuiteTag -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word16 -> Value)
-> (CipherSuiteTag -> Word16) -> CipherSuiteTag -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherSuite -> Word16
cipherSuiteNumber (CipherSuite -> Word16)
-> (CipherSuiteTag -> CipherSuite) -> CipherSuiteTag -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherSuiteTag -> CipherSuite
tagCipherSuite)
    where
      tagParser :: Value -> Parser CipherSuiteTag
tagParser Value
v = do
        Word16
index <- Value -> Parser Word16
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        Parser CipherSuiteTag
-> (CipherSuiteTag -> Parser CipherSuiteTag)
-> Maybe CipherSuiteTag
-> Parser CipherSuiteTag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> Parser CipherSuiteTag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a valid index number of a ciphersuite. See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5.")
          CipherSuiteTag -> Parser CipherSuiteTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (CipherSuite -> Maybe CipherSuiteTag
cipherSuiteTag (Word16 -> CipherSuite
CipherSuite Word16
index))

instance C.Cql CipherSuiteTag where
  ctype :: Tagged CipherSuiteTag ColumnType
ctype = ColumnType -> Tagged CipherSuiteTag ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
IntColumn
  toCql :: CipherSuiteTag -> Value
toCql = Int32 -> Value
CqlInt (Int32 -> Value)
-> (CipherSuiteTag -> Int32) -> CipherSuiteTag -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int32)
-> (CipherSuiteTag -> Word16) -> CipherSuiteTag -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherSuite -> Word16
cipherSuiteNumber (CipherSuite -> Word16)
-> (CipherSuiteTag -> CipherSuite) -> CipherSuiteTag -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherSuiteTag -> CipherSuite
tagCipherSuite

  fromCql :: Value -> Either String CipherSuiteTag
fromCql (CqlInt Int32
index) =
    case CipherSuite -> Maybe CipherSuiteTag
cipherSuiteTag (Word16 -> CipherSuite
CipherSuite (Int32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index)) of
      Just CipherSuiteTag
t -> CipherSuiteTag -> Either String CipherSuiteTag
forall a b. b -> Either a b
Right CipherSuiteTag
t
      Maybe CipherSuiteTag
Nothing -> String -> Either String CipherSuiteTag
forall a b. a -> Either a b
Left String
"CipherSuiteTag: unexpected index"
  fromCql Value
_ = String -> Either String CipherSuiteTag
forall a b. a -> Either a b
Left String
"CipherSuiteTag: int expected"

-- | See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5.
cipherSuiteTag :: CipherSuite -> Maybe CipherSuiteTag
cipherSuiteTag :: CipherSuite -> Maybe CipherSuiteTag
cipherSuiteTag CipherSuite
cs = [CipherSuiteTag] -> Maybe CipherSuiteTag
forall a. [a] -> Maybe a
listToMaybe ([CipherSuiteTag] -> Maybe CipherSuiteTag)
-> [CipherSuiteTag] -> Maybe CipherSuiteTag
forall a b. (a -> b) -> a -> b
$ do
  CipherSuiteTag
t <- [CipherSuiteTag
forall a. Bounded a => a
minBound .. CipherSuiteTag
forall a. Bounded a => a
maxBound]
  Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CipherSuiteTag -> CipherSuite
tagCipherSuite CipherSuiteTag
t CipherSuite -> CipherSuite -> Bool
forall a. Eq a => a -> a -> Bool
== CipherSuite
cs)
  CipherSuiteTag -> [CipherSuiteTag]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure CipherSuiteTag
t

-- | Inverse of 'cipherSuiteTag'
tagCipherSuite :: CipherSuiteTag -> CipherSuite
tagCipherSuite :: CipherSuiteTag -> CipherSuite
tagCipherSuite CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = Word16 -> CipherSuite
CipherSuite Word16
0x1
tagCipherSuite CipherSuiteTag
MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = Word16 -> CipherSuite
CipherSuite Word16
0x2
tagCipherSuite CipherSuiteTag
MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = Word16 -> CipherSuite
CipherSuite Word16
0x7
tagCipherSuite CipherSuiteTag
MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = Word16 -> CipherSuite
CipherSuite Word16
0x5
tagCipherSuite CipherSuiteTag
MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = Word16 -> CipherSuite
CipherSuite Word16
0xf031

data SomeHashAlgorithm where
  SomeHashAlgorithm :: (HashAlgorithm a) => a -> SomeHashAlgorithm

csHashAlgorithm :: CipherSuiteTag -> SomeHashAlgorithm
csHashAlgorithm :: CipherSuiteTag -> SomeHashAlgorithm
csHashAlgorithm CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = SHA256 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA256
SHA256
csHashAlgorithm CipherSuiteTag
MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = SHA256 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA256
SHA256
csHashAlgorithm CipherSuiteTag
MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = SHA384 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA384
SHA384
csHashAlgorithm CipherSuiteTag
MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = SHA512 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA512
SHA512
csHashAlgorithm CipherSuiteTag
MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = SHA256 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA256
SHA256

csHash :: CipherSuiteTag -> ByteString -> RawMLS a -> ByteString
csHash :: forall a. CipherSuiteTag -> ByteString -> RawMLS a -> ByteString
csHash CipherSuiteTag
cs ByteString
ctx RawMLS a
value = case CipherSuiteTag -> SomeHashAlgorithm
csHashAlgorithm CipherSuiteTag
cs of
  SomeHashAlgorithm a
a -> Digest a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest a -> ByteString)
-> (RefHashInput a -> Digest a) -> RefHashInput a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString -> Digest a
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith a
a (ByteString -> Digest a)
-> (RefHashInput a -> ByteString) -> RefHashInput a -> Digest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefHashInput a -> ByteString
forall a. SerialiseMLS a => a -> ByteString
encodeMLS' (RefHashInput a -> ByteString) -> RefHashInput a -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> RawMLS a -> RefHashInput a
forall a. ByteString -> RawMLS a -> RefHashInput a
RefHashInput ByteString
ctx RawMLS a
value

csVerifySignature :: CipherSuiteTag -> ByteString -> RawMLS a -> ByteString -> Bool
csVerifySignature :: forall a.
CipherSuiteTag -> ByteString -> RawMLS a -> ByteString -> Bool
csVerifySignature CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = ByteString -> RawMLS a -> ByteString -> Bool
forall a. ByteString -> RawMLS a -> ByteString -> Bool
ed25519VerifySignature
csVerifySignature CipherSuiteTag
MLS_128_DHKEMP256_AES128GCM_SHA256_P256 =
  Proxy Curve_P256R1
-> SHA256 -> ByteString -> RawMLS a -> ByteString -> Bool
forall curve a hash.
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
Proxy curve -> hash -> ByteString -> RawMLS a -> ByteString -> Bool
ECDSA.verifySignature (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P256R1) SHA256
SHA256
csVerifySignature CipherSuiteTag
MLS_256_DHKEMP384_AES256GCM_SHA384_P384 =
  Proxy Curve_P384R1
-> SHA384 -> ByteString -> RawMLS a -> ByteString -> Bool
forall curve a hash.
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
Proxy curve -> hash -> ByteString -> RawMLS a -> ByteString -> Bool
ECDSA.verifySignature (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P384R1) SHA384
SHA384
csVerifySignature CipherSuiteTag
MLS_256_DHKEMP521_AES256GCM_SHA512_P521 =
  Proxy Curve_P521R1
-> SHA512 -> ByteString -> RawMLS a -> ByteString -> Bool
forall curve a hash.
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
Proxy curve -> hash -> ByteString -> RawMLS a -> ByteString -> Bool
ECDSA.verifySignature (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P521R1) SHA512
SHA512
csVerifySignature CipherSuiteTag
MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = ByteString -> RawMLS a -> ByteString -> Bool
forall a. ByteString -> RawMLS a -> ByteString -> Bool
ed25519VerifySignature

ed25519VerifySignature :: ByteString -> RawMLS a -> ByteString -> Bool
ed25519VerifySignature :: forall a. ByteString -> RawMLS a -> ByteString -> Bool
ed25519VerifySignature ByteString
pub RawMLS a
x ByteString
sig =
  Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (CryptoFailable Bool -> Maybe Bool)
-> CryptoFailable Bool
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable Bool -> Maybe Bool
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable Bool -> Bool) -> CryptoFailable Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
    PublicKey
pub' <- ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey ByteString
pub
    Signature
sig' <- ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
sig
    Bool -> CryptoFailable Bool
forall a. a -> CryptoFailable a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> CryptoFailable Bool) -> Bool -> CryptoFailable Bool
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pub' RawMLS a
x.raw Signature
sig'

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-5.2-5
type RefHashInput = SignContent

pattern RefHashInput :: ByteString -> RawMLS a -> RefHashInput a
pattern $mRefHashInput :: forall {r} {a}.
RefHashInput a
-> (ByteString -> RawMLS a -> r) -> ((# #) -> r) -> r
$bRefHashInput :: forall a. ByteString -> RawMLS a -> RefHashInput a
RefHashInput label content = SignContent label content

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-5.1.2-6
data SignContent a = SignContent
  { forall a. SignContent a -> ByteString
sigLabel :: ByteString,
    forall a. SignContent a -> RawMLS a
content :: RawMLS a
  }

instance SerialiseMLS (SignContent a) where
  serialiseMLS :: SignContent a -> Put
serialiseMLS SignContent a
c = do
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt SignContent a
c.sigLabel
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt SignContent a
c.content.raw

mkSignContent :: ByteString -> RawMLS a -> SignContent a
mkSignContent :: forall a. ByteString -> RawMLS a -> RefHashInput a
mkSignContent ByteString
sigLabel RawMLS a
content =
  SignContent
    { $sel:sigLabel:SignContent :: ByteString
sigLabel = ByteString
"MLS 1.0 " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sigLabel,
      $sel:content:SignContent :: RawMLS a
content = RawMLS a
content
    }

csVerifySignatureWithLabel ::
  CipherSuiteTag ->
  ByteString ->
  ByteString ->
  RawMLS a ->
  ByteString ->
  Bool
csVerifySignatureWithLabel :: forall a.
CipherSuiteTag
-> ByteString -> ByteString -> RawMLS a -> ByteString -> Bool
csVerifySignatureWithLabel CipherSuiteTag
cs ByteString
pub ByteString
label RawMLS a
x ByteString
sig =
  CipherSuiteTag
-> ByteString -> RawMLS (SignContent a) -> ByteString -> Bool
forall a.
CipherSuiteTag -> ByteString -> RawMLS a -> ByteString -> Bool
csVerifySignature CipherSuiteTag
cs ByteString
pub (SignContent a -> RawMLS (SignContent a)
forall a. SerialiseMLS a => a -> RawMLS a
mkRawMLS (ByteString -> RawMLS a -> SignContent a
forall a. ByteString -> RawMLS a -> RefHashInput a
mkSignContent ByteString
label RawMLS a
x)) ByteString
sig

signWithLabel ::
  forall ss a m.
  (IsSignatureScheme ss, MonadRandom m) =>
  ByteString ->
  KeyPair ss ->
  RawMLS a ->
  m ByteString
signWithLabel :: forall (ss :: SignatureSchemeTag) a (m :: * -> *).
(IsSignatureScheme ss, MonadRandom m) =>
ByteString -> KeyPair ss -> RawMLS a -> m ByteString
signWithLabel ByteString
sigLabel KeyPair ss
kp RawMLS a
x = forall (ss :: SignatureSchemeTag) (m :: * -> *).
(IsSignatureScheme ss, MonadRandom m) =>
KeyPair ss -> ByteString -> m ByteString
sign @ss KeyPair ss
kp (SignContent a -> ByteString
forall a. SerialiseMLS a => a -> ByteString
encodeMLS' (ByteString -> RawMLS a -> SignContent a
forall a. ByteString -> RawMLS a -> RefHashInput a
mkSignContent ByteString
sigLabel RawMLS a
x))

csSignatureScheme :: CipherSuiteTag -> SignatureSchemeTag
csSignatureScheme :: CipherSuiteTag -> SignatureSchemeTag
csSignatureScheme CipherSuiteTag
MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = SignatureSchemeTag
Ed25519
csSignatureScheme CipherSuiteTag
MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = SignatureSchemeTag
Ecdsa_secp256r1_sha256
csSignatureScheme CipherSuiteTag
MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = SignatureSchemeTag
Ecdsa_secp384r1_sha384
csSignatureScheme CipherSuiteTag
MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = SignatureSchemeTag
Ecdsa_secp521r1_sha512
csSignatureScheme CipherSuiteTag
MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = SignatureSchemeTag
Ed25519

type family PrivateKey (ss :: SignatureSchemeTag)

type instance PrivateKey Ed25519 = Ed25519.SecretKey

type instance PrivateKey Ecdsa_secp256r1_sha256 = ECDSA.PrivateKey Curve_P256R1

type instance PrivateKey Ecdsa_secp384r1_sha384 = ECDSA.PrivateKey Curve_P384R1

type instance PrivateKey Ecdsa_secp521r1_sha512 = ECDSA.PrivateKey Curve_P521R1

type family PublicKey (ss :: SignatureSchemeTag)

type instance PublicKey Ed25519 = Ed25519.PublicKey

type instance PublicKey Ecdsa_secp256r1_sha256 = ECDSA.PublicKey Curve_P256R1

type instance PublicKey Ecdsa_secp384r1_sha384 = ECDSA.PublicKey Curve_P384R1

type instance PublicKey Ecdsa_secp521r1_sha512 = ECDSA.PublicKey Curve_P521R1

type KeyPair (ss :: SignatureSchemeTag) = (PrivateKey ss, PublicKey ss)

-- | A TLS signature scheme.
--
-- See <https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-signaturescheme>.
newtype SignatureScheme = SignatureScheme {SignatureScheme -> Word16
unSignatureScheme :: Word16}
  deriving stock (SignatureScheme -> SignatureScheme -> Bool
(SignatureScheme -> SignatureScheme -> Bool)
-> (SignatureScheme -> SignatureScheme -> Bool)
-> Eq SignatureScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignatureScheme -> SignatureScheme -> Bool
== :: SignatureScheme -> SignatureScheme -> Bool
$c/= :: SignatureScheme -> SignatureScheme -> Bool
/= :: SignatureScheme -> SignatureScheme -> Bool
Eq, Int -> SignatureScheme -> ShowS
[SignatureScheme] -> ShowS
SignatureScheme -> String
(Int -> SignatureScheme -> ShowS)
-> (SignatureScheme -> String)
-> ([SignatureScheme] -> ShowS)
-> Show SignatureScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignatureScheme -> ShowS
showsPrec :: Int -> SignatureScheme -> ShowS
$cshow :: SignatureScheme -> String
show :: SignatureScheme -> String
$cshowList :: [SignatureScheme] -> ShowS
showList :: [SignatureScheme] -> ShowS
Show)
  deriving newtype (Get SignatureScheme
Get SignatureScheme -> ParseMLS SignatureScheme
forall a. Get a -> ParseMLS a
$cparseMLS :: Get SignatureScheme
parseMLS :: Get SignatureScheme
ParseMLS, Gen SignatureScheme
Gen SignatureScheme
-> (SignatureScheme -> [SignatureScheme])
-> Arbitrary SignatureScheme
SignatureScheme -> [SignatureScheme]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SignatureScheme
arbitrary :: Gen SignatureScheme
$cshrink :: SignatureScheme -> [SignatureScheme]
shrink :: SignatureScheme -> [SignatureScheme]
Arbitrary)

data SignatureSchemeTag
  = Ed25519
  | Ecdsa_secp256r1_sha256
  | Ecdsa_secp384r1_sha384
  | Ecdsa_secp521r1_sha512
  deriving stock (SignatureSchemeTag
SignatureSchemeTag
-> SignatureSchemeTag -> Bounded SignatureSchemeTag
forall a. a -> a -> Bounded a
$cminBound :: SignatureSchemeTag
minBound :: SignatureSchemeTag
$cmaxBound :: SignatureSchemeTag
maxBound :: SignatureSchemeTag
Bounded, Int -> SignatureSchemeTag
SignatureSchemeTag -> Int
SignatureSchemeTag -> [SignatureSchemeTag]
SignatureSchemeTag -> SignatureSchemeTag
SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
SignatureSchemeTag
-> SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
(SignatureSchemeTag -> SignatureSchemeTag)
-> (SignatureSchemeTag -> SignatureSchemeTag)
-> (Int -> SignatureSchemeTag)
-> (SignatureSchemeTag -> Int)
-> (SignatureSchemeTag -> [SignatureSchemeTag])
-> (SignatureSchemeTag
    -> SignatureSchemeTag -> [SignatureSchemeTag])
-> (SignatureSchemeTag
    -> SignatureSchemeTag -> [SignatureSchemeTag])
-> (SignatureSchemeTag
    -> SignatureSchemeTag
    -> SignatureSchemeTag
    -> [SignatureSchemeTag])
-> Enum SignatureSchemeTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SignatureSchemeTag -> SignatureSchemeTag
succ :: SignatureSchemeTag -> SignatureSchemeTag
$cpred :: SignatureSchemeTag -> SignatureSchemeTag
pred :: SignatureSchemeTag -> SignatureSchemeTag
$ctoEnum :: Int -> SignatureSchemeTag
toEnum :: Int -> SignatureSchemeTag
$cfromEnum :: SignatureSchemeTag -> Int
fromEnum :: SignatureSchemeTag -> Int
$cenumFrom :: SignatureSchemeTag -> [SignatureSchemeTag]
enumFrom :: SignatureSchemeTag -> [SignatureSchemeTag]
$cenumFromThen :: SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
enumFromThen :: SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
$cenumFromTo :: SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
enumFromTo :: SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
$cenumFromThenTo :: SignatureSchemeTag
-> SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
enumFromThenTo :: SignatureSchemeTag
-> SignatureSchemeTag -> SignatureSchemeTag -> [SignatureSchemeTag]
Enum, SignatureSchemeTag -> SignatureSchemeTag -> Bool
(SignatureSchemeTag -> SignatureSchemeTag -> Bool)
-> (SignatureSchemeTag -> SignatureSchemeTag -> Bool)
-> Eq SignatureSchemeTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
== :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
$c/= :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
/= :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
Eq, Eq SignatureSchemeTag
Eq SignatureSchemeTag =>
(SignatureSchemeTag -> SignatureSchemeTag -> Ordering)
-> (SignatureSchemeTag -> SignatureSchemeTag -> Bool)
-> (SignatureSchemeTag -> SignatureSchemeTag -> Bool)
-> (SignatureSchemeTag -> SignatureSchemeTag -> Bool)
-> (SignatureSchemeTag -> SignatureSchemeTag -> Bool)
-> (SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag)
-> (SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag)
-> Ord SignatureSchemeTag
SignatureSchemeTag -> SignatureSchemeTag -> Bool
SignatureSchemeTag -> SignatureSchemeTag -> Ordering
SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag
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
$ccompare :: SignatureSchemeTag -> SignatureSchemeTag -> Ordering
compare :: SignatureSchemeTag -> SignatureSchemeTag -> Ordering
$c< :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
< :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
$c<= :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
<= :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
$c> :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
> :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
$c>= :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
>= :: SignatureSchemeTag -> SignatureSchemeTag -> Bool
$cmax :: SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag
max :: SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag
$cmin :: SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag
min :: SignatureSchemeTag -> SignatureSchemeTag -> SignatureSchemeTag
Ord, Int -> SignatureSchemeTag -> ShowS
[SignatureSchemeTag] -> ShowS
SignatureSchemeTag -> String
(Int -> SignatureSchemeTag -> ShowS)
-> (SignatureSchemeTag -> String)
-> ([SignatureSchemeTag] -> ShowS)
-> Show SignatureSchemeTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignatureSchemeTag -> ShowS
showsPrec :: Int -> SignatureSchemeTag -> ShowS
$cshow :: SignatureSchemeTag -> String
show :: SignatureSchemeTag -> String
$cshowList :: [SignatureSchemeTag] -> ShowS
showList :: [SignatureSchemeTag] -> ShowS
Show, (forall x. SignatureSchemeTag -> Rep SignatureSchemeTag x)
-> (forall x. Rep SignatureSchemeTag x -> SignatureSchemeTag)
-> Generic SignatureSchemeTag
forall x. Rep SignatureSchemeTag x -> SignatureSchemeTag
forall x. SignatureSchemeTag -> Rep SignatureSchemeTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SignatureSchemeTag -> Rep SignatureSchemeTag x
from :: forall x. SignatureSchemeTag -> Rep SignatureSchemeTag x
$cto :: forall x. Rep SignatureSchemeTag x -> SignatureSchemeTag
to :: forall x. Rep SignatureSchemeTag x -> SignatureSchemeTag
Generic)
  deriving (Gen SignatureSchemeTag
Gen SignatureSchemeTag
-> (SignatureSchemeTag -> [SignatureSchemeTag])
-> Arbitrary SignatureSchemeTag
SignatureSchemeTag -> [SignatureSchemeTag]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SignatureSchemeTag
arbitrary :: Gen SignatureSchemeTag
$cshrink :: SignatureSchemeTag -> [SignatureSchemeTag]
shrink :: SignatureSchemeTag -> [SignatureSchemeTag]
Arbitrary) via GenericUniform SignatureSchemeTag

class IsSignatureScheme (ss :: SignatureSchemeTag) where
  sign :: (MonadRandom m) => KeyPair ss -> ByteString -> m ByteString

instance IsSignatureScheme 'Ed25519 where
  sign :: forall (m :: * -> *).
MonadRandom m =>
KeyPair 'Ed25519 -> ByteString -> m ByteString
sign (PrivateKey 'Ed25519
priv, PublicKey 'Ed25519
pub) = ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (ByteString -> ByteString) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Signature -> ByteString)
-> (ByteString -> Signature) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
PrivateKey 'Ed25519
priv PublicKey
PublicKey 'Ed25519
pub

instance IsSignatureScheme 'Ecdsa_secp256r1_sha256 where
  sign :: forall (m :: * -> *).
MonadRandom m =>
KeyPair 'Ecdsa_secp256r1_sha256 -> ByteString -> m ByteString
sign (PrivateKey 'Ecdsa_secp256r1_sha256
priv, PublicKey 'Ecdsa_secp256r1_sha256
_) =
    (Signature Curve_P256R1 -> ByteString)
-> m (Signature Curve_P256R1) -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy Curve_P256R1 -> Signature Curve_P256R1 -> ByteString
forall curve.
EllipticCurveECDSA curve =>
Proxy curve -> Signature curve -> ByteString
ECDSA.encodeSignature (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P256R1))
      (m (Signature Curve_P256R1) -> m ByteString)
-> (ByteString -> m (Signature Curve_P256R1))
-> ByteString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Curve_P256R1
-> PrivateKey Curve_P256R1
-> SHA256
-> ByteString
-> m (Signature Curve_P256R1)
forall curve (m :: * -> *) msg hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg,
 HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> hash -> msg -> m (Signature curve)
ECDSA.sign (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P256R1) PrivateKey Curve_P256R1
PrivateKey 'Ecdsa_secp256r1_sha256
priv SHA256
SHA256

instance IsSignatureScheme 'Ecdsa_secp384r1_sha384 where
  sign :: forall (m :: * -> *).
MonadRandom m =>
KeyPair 'Ecdsa_secp384r1_sha384 -> ByteString -> m ByteString
sign (PrivateKey 'Ecdsa_secp384r1_sha384
priv, PublicKey 'Ecdsa_secp384r1_sha384
_) =
    (Signature Curve_P384R1 -> ByteString)
-> m (Signature Curve_P384R1) -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy Curve_P384R1 -> Signature Curve_P384R1 -> ByteString
forall curve.
EllipticCurveECDSA curve =>
Proxy curve -> Signature curve -> ByteString
ECDSA.encodeSignature (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P384R1))
      (m (Signature Curve_P384R1) -> m ByteString)
-> (ByteString -> m (Signature Curve_P384R1))
-> ByteString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Curve_P384R1
-> PrivateKey Curve_P384R1
-> SHA384
-> ByteString
-> m (Signature Curve_P384R1)
forall curve (m :: * -> *) msg hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg,
 HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> hash -> msg -> m (Signature curve)
ECDSA.sign (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P384R1) PrivateKey Curve_P384R1
PrivateKey 'Ecdsa_secp384r1_sha384
priv SHA384
SHA384

instance IsSignatureScheme 'Ecdsa_secp521r1_sha512 where
  sign :: forall (m :: * -> *).
MonadRandom m =>
KeyPair 'Ecdsa_secp521r1_sha512 -> ByteString -> m ByteString
sign (PrivateKey 'Ecdsa_secp521r1_sha512
priv, PublicKey 'Ecdsa_secp521r1_sha512
_) =
    (Signature Curve_P521R1 -> ByteString)
-> m (Signature Curve_P521R1) -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy Curve_P521R1 -> Signature Curve_P521R1 -> ByteString
forall curve.
EllipticCurveECDSA curve =>
Proxy curve -> Signature curve -> ByteString
ECDSA.encodeSignature (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P521R1))
      (m (Signature Curve_P521R1) -> m ByteString)
-> (ByteString -> m (Signature Curve_P521R1))
-> ByteString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Curve_P521R1
-> PrivateKey Curve_P521R1
-> SHA512
-> ByteString
-> m (Signature Curve_P521R1)
forall curve (m :: * -> *) msg hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg,
 HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> hash -> msg -> m (Signature curve)
ECDSA.sign (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Curve_P521R1) PrivateKey Curve_P521R1
PrivateKey 'Ecdsa_secp521r1_sha512
priv SHA512
SHA512

type family SignatureSchemeCurve (ss :: SignatureSchemeTag)

type instance SignatureSchemeCurve 'Ecdsa_secp256r1_sha256 = Curve_P256R1

type instance SignatureSchemeCurve 'Ecdsa_secp384r1_sha384 = Curve_P384R1

type instance SignatureSchemeCurve 'Ecdsa_secp521r1_sha512 = Curve_P521R1

instance Cql SignatureSchemeTag where
  ctype :: Tagged SignatureSchemeTag ColumnType
ctype = ColumnType -> Tagged SignatureSchemeTag ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
TextColumn
  toCql :: SignatureSchemeTag -> Value
toCql = Text -> Value
CqlText (Text -> Value)
-> (SignatureSchemeTag -> Text) -> SignatureSchemeTag -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignatureSchemeTag -> Text
signatureSchemeName
  fromCql :: Value -> Either String SignatureSchemeTag
fromCql (CqlText Text
name) =
    String
-> Maybe SignatureSchemeTag -> Either String SignatureSchemeTag
forall a b. a -> Maybe b -> Either a b
note (String
"Unexpected signature scheme: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name) (Maybe SignatureSchemeTag -> Either String SignatureSchemeTag)
-> Maybe SignatureSchemeTag -> Either String SignatureSchemeTag
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe SignatureSchemeTag
signatureSchemeFromName Text
name
  fromCql Value
_ = String -> Either String SignatureSchemeTag
forall a b. a -> Either a b
Left String
"SignatureScheme: Text expected"

signatureSchemeName :: SignatureSchemeTag -> Text
signatureSchemeName :: SignatureSchemeTag -> Text
signatureSchemeName SignatureSchemeTag
Ed25519 = Text
"ed25519"
signatureSchemeName SignatureSchemeTag
Ecdsa_secp256r1_sha256 = Text
"ecdsa_secp256r1_sha256"
signatureSchemeName SignatureSchemeTag
Ecdsa_secp384r1_sha384 = Text
"ecdsa_secp384r1_sha384"
signatureSchemeName SignatureSchemeTag
Ecdsa_secp521r1_sha512 = Text
"ecdsa_secp521r1_sha512"

signatureSchemeFromName :: Text -> Maybe SignatureSchemeTag
signatureSchemeFromName :: Text -> Maybe SignatureSchemeTag
signatureSchemeFromName Text
name = Alt Maybe SignatureSchemeTag -> Maybe SignatureSchemeTag
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt Maybe SignatureSchemeTag -> Maybe SignatureSchemeTag)
-> Alt Maybe SignatureSchemeTag -> Maybe SignatureSchemeTag
forall a b. (a -> b) -> a -> b
$
  ((SignatureSchemeTag -> Alt Maybe SignatureSchemeTag)
 -> [SignatureSchemeTag] -> Alt Maybe SignatureSchemeTag)
-> [SignatureSchemeTag]
-> (SignatureSchemeTag -> Alt Maybe SignatureSchemeTag)
-> Alt Maybe SignatureSchemeTag
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SignatureSchemeTag -> Alt Maybe SignatureSchemeTag)
-> [SignatureSchemeTag] -> Alt Maybe SignatureSchemeTag
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [SignatureSchemeTag
forall a. Bounded a => a
minBound .. SignatureSchemeTag
forall a. Bounded a => a
maxBound] ((SignatureSchemeTag -> Alt Maybe SignatureSchemeTag)
 -> Alt Maybe SignatureSchemeTag)
-> (SignatureSchemeTag -> Alt Maybe SignatureSchemeTag)
-> Alt Maybe SignatureSchemeTag
forall a b. (a -> b) -> a -> b
$ \SignatureSchemeTag
s ->
    Bool -> Alt Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SignatureSchemeTag -> Text
signatureSchemeName SignatureSchemeTag
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) Alt Maybe () -> SignatureSchemeTag -> Alt Maybe SignatureSchemeTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SignatureSchemeTag
s

parseSignatureScheme :: (MonadFail f) => Text -> f SignatureSchemeTag
parseSignatureScheme :: forall (f :: * -> *). MonadFail f => Text -> f SignatureSchemeTag
parseSignatureScheme Text
name =
  f SignatureSchemeTag
-> (SignatureSchemeTag -> f SignatureSchemeTag)
-> Maybe SignatureSchemeTag
-> f SignatureSchemeTag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> f SignatureSchemeTag
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported signature scheme " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name))
    SignatureSchemeTag -> f SignatureSchemeTag
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Text -> Maybe SignatureSchemeTag
signatureSchemeFromName Text
name)

instance FromJSON SignatureSchemeTag where
  parseJSON :: Value -> Parser SignatureSchemeTag
parseJSON = String
-> (Text -> Parser SignatureSchemeTag)
-> Value
-> Parser SignatureSchemeTag
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"SignatureScheme" Text -> Parser SignatureSchemeTag
forall (f :: * -> *). MonadFail f => Text -> f SignatureSchemeTag
parseSignatureScheme

instance FromJSONKey SignatureSchemeTag where
  fromJSONKey :: FromJSONKeyFunction SignatureSchemeTag
fromJSONKey = (Text -> Parser SignatureSchemeTag)
-> FromJSONKeyFunction SignatureSchemeTag
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser SignatureSchemeTag
forall (f :: * -> *). MonadFail f => Text -> f SignatureSchemeTag
parseSignatureScheme

instance S.ToParamSchema SignatureSchemeTag where
  toParamSchema :: Proxy SignatureSchemeTag -> Schema
toParamSchema Proxy SignatureSchemeTag
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString

instance FromHttpApiData SignatureSchemeTag where
  parseQueryParam :: Text -> Either Text SignatureSchemeTag
parseQueryParam = Text -> Maybe SignatureSchemeTag -> Either Text SignatureSchemeTag
forall a b. a -> Maybe b -> Either a b
note Text
"Unknown signature scheme" (Maybe SignatureSchemeTag -> Either Text SignatureSchemeTag)
-> (Text -> Maybe SignatureSchemeTag)
-> Text
-> Either Text SignatureSchemeTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe SignatureSchemeTag
signatureSchemeFromName

instance ToJSON SignatureSchemeTag where
  toJSON :: SignatureSchemeTag -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (SignatureSchemeTag -> Text) -> SignatureSchemeTag -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignatureSchemeTag -> Text
signatureSchemeName

instance ToJSONKey SignatureSchemeTag where
  toJSONKey :: ToJSONKeyFunction SignatureSchemeTag
toJSONKey = (SignatureSchemeTag -> Text)
-> ToJSONKeyFunction SignatureSchemeTag
forall a. (a -> Text) -> ToJSONKeyFunction a
Aeson.toJSONKeyText SignatureSchemeTag -> Text
signatureSchemeName

instance S.ToSchema SignatureSchemeTag where
  declareNamedSchema :: Proxy SignatureSchemeTag
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy SignatureSchemeTag
_ = Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
S.declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)