This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Jose/Jwk/Instances.hs
2022-10-12 09:35:16 +02:00

78 lines
2.1 KiB
Haskell

-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Jose.Jwk.Instances
() where
import ClassyPrelude
import Model.Types.TH.JSON
import Jose.Jwk
import Jose.Jwt
import Jose.Jwa
import Crypto.PubKey.ECC.Types
import Crypto.PubKey.ECC.ECDSA
import Data.Swagger.Schema (ToSchema(..))
import Data.Swagger.Internal.Schema (named)
import Servant.Docs (ToSample(..))
import Crypto.Random
deriving instance Generic EcCurve
deriving anyclass instance NFData EcCurve
deriving instance Generic CurveCommon
deriving anyclass instance NFData CurveCommon
deriving instance Generic CurvePrime
deriving anyclass instance NFData CurvePrime
deriving instance Generic Curve
deriving anyclass instance NFData Curve
deriving instance Generic PublicKey
deriving anyclass instance NFData PublicKey
deriving instance Generic JweAlg
deriving anyclass instance NFData JweAlg
deriving instance Generic JwsAlg
deriving anyclass instance NFData JwsAlg
deriving instance Generic Alg
deriving anyclass instance NFData Alg
deriving instance Generic KeyUse
deriving anyclass instance NFData KeyUse
deriving instance Generic KeyId
deriving anyclass instance NFData KeyId
deriving instance Generic KeyPair
deriving anyclass instance NFData KeyPair
deriving instance Generic Jwk
deriving anyclass instance NFData Jwk
derivePersistFieldJSON ''JwkSet
deriving anyclass instance NFData JwkSet
instance ToSchema Jwk where
declareNamedSchema _ = pure $ named "Jwk" mempty
instance ToSchema JwkSet
sampleNotRandom :: MonadPseudoRandom ChaChaDRG a -> a
sampleNotRandom = fst . withDRG (drgNewSeed $ seedFromInteger 0)
instance ToSample JwkSet where
toSamples _ = [ ("Symmetric key", JwkSet [symmKey])
, ("Asymmetric keyset", JwkSet [rsaPub, rsaPriv])
, ("Symmetric & asymmetric keysets", JwkSet [symmKey, rsaPub, rsaPriv])
]
where
symmKey = sampleNotRandom $
generateSymmetricKey 8 (KeyId "sample") Enc Nothing
(rsaPub, rsaPriv) = sampleNotRandom $
generateRsaKeyPair 128 (KeyId "sample RSA") Enc Nothing