module Crypto.JOSE.Legacy
(
JWK'(..)
, toJWK
, RSKeyParameters()
, rsaKeyParameters
) where
import Control.Applicative
import Data.Bifunctor
import GHC.Types (Int(I#))
import GHC.Integer.Logarithms (integerLog2#)
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Text as T
import Safe (readMay)
import Crypto.JOSE.Classes
import Crypto.JOSE.JWA.JWK
import Crypto.JOSE.JWK
import qualified Crypto.JOSE.Types.Internal as Types
import Crypto.JOSE.Types
import Crypto.JOSE.TH
newtype StringifiedInteger = StringifiedInteger { _unString :: Integer }
makeLenses ''StringifiedInteger
instance FromJSON StringifiedInteger where
parseJSON = withText "StringifiedInteger" $
maybe (fail "not an stringy integer") (pure . StringifiedInteger)
. readMay
. T.unpack
instance ToJSON StringifiedInteger where
toJSON (StringifiedInteger n) = toJSON $ show n
b64Iso :: Iso' StringifiedInteger Base64Integer
b64Iso = iso
(Base64Integer . view unString)
(\(Base64Integer n) -> StringifiedInteger n)
sizedB64Iso :: Iso' StringifiedInteger SizedBase64Integer
sizedB64Iso = iso
((\n -> SizedBase64Integer (size n) n) . view unString)
(\(SizedBase64Integer _ n) -> StringifiedInteger n)
where
size n =
let (bytes, bits) = (I# (integerLog2# n) + 1) `divMod` 8
in bytes + signum bits
$(Crypto.JOSE.TH.deriveJOSEType "RS" ["RS"])
newtype RSKeyParameters = RSKeyParameters { _rsaKeyParameters :: RSAKeyParameters }
deriving (Eq, Show)
makeLenses ''RSKeyParameters
instance FromJSON RSKeyParameters where
parseJSON = withObject "RS" $ \o -> fmap RSKeyParameters $ RSAKeyParameters
<$> ((o .: "algorithm" :: Parser RS) *> pure RSA)
<*> (view sizedB64Iso <$> o .: "n")
<*> (view b64Iso <$> o .: "e")
<*> (fmap ((`RSAPrivateKeyParameters` Nothing) . view b64Iso) <$> (o .:? "d"))
instance ToJSON RSKeyParameters where
toJSON (RSKeyParameters k)
= object $
[ "algorithm" .= RS
, "n" .= (k ^. rsaN . from sizedB64Iso)
, "e" .= (k ^. rsaE . from b64Iso)
]
++ maybe [] (\p -> ["d" .= (rsaD p ^. from b64Iso)])
(k ^. rsaPrivateKeyParameters)
instance Key RSKeyParameters where
type KeyGenParam RSKeyParameters = Int
type KeyContent RSKeyParameters = RSAKeyParameters
gen p = first fromKeyContent . gen p
fromKeyContent = RSKeyParameters
public = rsaKeyParameters public
sign h (RSKeyParameters k) = sign h k
verify h (RSKeyParameters k) = verify h k
newtype JWK' = JWK' { _rsKeyParameters :: RSKeyParameters }
deriving (Eq, Show)
makeLenses ''JWK'
instance FromJSON JWK' where
parseJSON = withObject "JWK'" $ \o -> JWK' <$> parseJSON (Object o)
instance ToJSON JWK' where
toJSON (JWK' k) = object $ Types.objectPairs (toJSON k)
instance Key JWK' where
type KeyGenParam JWK' = Int
type KeyContent JWK' = RSKeyParameters
gen p g = first JWK' $ gen p g
fromKeyContent = JWK'
public = rsKeyParameters public
sign h (JWK' k) = sign h k
verify h (JWK' k) = verify h k
toJWK :: JWK' -> JWK
toJWK (JWK' (RSKeyParameters k)) = fromKeyContent $ RSAKeyMaterial k