{-# LANGUAGE RecordWildCards #-}
-- Manipulating JWT claims with addClaim etc. directly is deprecated, so we'll need to fix that eventually.
-- The new way appears to be to define custom types with JSON instances and use those to encode/decode the JWT;
-- see https://github.com/frasertweedale/hs-jose/issues/116
-- https://github.com/unisonweb/unison/issues/5153
{-# OPTIONS_GHC -Wno-deprecations #-}

-- | Hash-related types in the Share API.
module Unison.Share.API.Hash
  ( -- * Hash types
    HashJWT (..),
    hashJWTHash,
    HashJWTClaims (..),
    DecodedHashJWT (..),
    decodeHashJWT,
    decodeHashJWTClaims,
    decodedHashJWTHash,
  )
where

import Control.Lens (folding, ix, (^?))
import Crypto.JWT qualified as Jose
import Data.Aeson
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as Aeson.KeyMap
import Servant.Auth.JWT qualified as Servant.Auth
import Unison.Hash32 (Hash32)
import Unison.Hash32.Orphans.Aeson ()
import Unison.Prelude
import Web.JWT qualified as JWT

newtype HashJWT = HashJWT {HashJWT -> Text
unHashJWT :: Text}
  deriving newtype (Int -> HashJWT -> ShowS
[HashJWT] -> ShowS
HashJWT -> [Char]
(Int -> HashJWT -> ShowS)
-> (HashJWT -> [Char]) -> ([HashJWT] -> ShowS) -> Show HashJWT
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashJWT -> ShowS
showsPrec :: Int -> HashJWT -> ShowS
$cshow :: HashJWT -> [Char]
show :: HashJWT -> [Char]
$cshowList :: [HashJWT] -> ShowS
showList :: [HashJWT] -> ShowS
Show, HashJWT -> HashJWT -> Bool
(HashJWT -> HashJWT -> Bool)
-> (HashJWT -> HashJWT -> Bool) -> Eq HashJWT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashJWT -> HashJWT -> Bool
== :: HashJWT -> HashJWT -> Bool
$c/= :: HashJWT -> HashJWT -> Bool
/= :: HashJWT -> HashJWT -> Bool
Eq, Eq HashJWT
Eq HashJWT =>
(HashJWT -> HashJWT -> Ordering)
-> (HashJWT -> HashJWT -> Bool)
-> (HashJWT -> HashJWT -> Bool)
-> (HashJWT -> HashJWT -> Bool)
-> (HashJWT -> HashJWT -> Bool)
-> (HashJWT -> HashJWT -> HashJWT)
-> (HashJWT -> HashJWT -> HashJWT)
-> Ord HashJWT
HashJWT -> HashJWT -> Bool
HashJWT -> HashJWT -> Ordering
HashJWT -> HashJWT -> HashJWT
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 :: HashJWT -> HashJWT -> Ordering
compare :: HashJWT -> HashJWT -> Ordering
$c< :: HashJWT -> HashJWT -> Bool
< :: HashJWT -> HashJWT -> Bool
$c<= :: HashJWT -> HashJWT -> Bool
<= :: HashJWT -> HashJWT -> Bool
$c> :: HashJWT -> HashJWT -> Bool
> :: HashJWT -> HashJWT -> Bool
$c>= :: HashJWT -> HashJWT -> Bool
>= :: HashJWT -> HashJWT -> Bool
$cmax :: HashJWT -> HashJWT -> HashJWT
max :: HashJWT -> HashJWT -> HashJWT
$cmin :: HashJWT -> HashJWT -> HashJWT
min :: HashJWT -> HashJWT -> HashJWT
Ord, [HashJWT] -> Value
[HashJWT] -> Encoding
HashJWT -> Value
HashJWT -> Encoding
(HashJWT -> Value)
-> (HashJWT -> Encoding)
-> ([HashJWT] -> Value)
-> ([HashJWT] -> Encoding)
-> ToJSON HashJWT
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: HashJWT -> Value
toJSON :: HashJWT -> Value
$ctoEncoding :: HashJWT -> Encoding
toEncoding :: HashJWT -> Encoding
$ctoJSONList :: [HashJWT] -> Value
toJSONList :: [HashJWT] -> Value
$ctoEncodingList :: [HashJWT] -> Encoding
toEncodingList :: [HashJWT] -> Encoding
ToJSON, Value -> Parser [HashJWT]
Value -> Parser HashJWT
(Value -> Parser HashJWT)
-> (Value -> Parser [HashJWT]) -> FromJSON HashJWT
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser HashJWT
parseJSON :: Value -> Parser HashJWT
$cparseJSONList :: Value -> Parser [HashJWT]
parseJSONList :: Value -> Parser [HashJWT]
FromJSON)

-- | Grab the hash out of a hash JWT.
--
-- This decodes the whole JWT, then throws away the claims; use it if you really only need the hash!
hashJWTHash :: HashJWT -> Hash32
hashJWTHash :: HashJWT -> Hash32
hashJWTHash =
  DecodedHashJWT -> Hash32
decodedHashJWTHash (DecodedHashJWT -> Hash32)
-> (HashJWT -> DecodedHashJWT) -> HashJWT -> Hash32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashJWT -> DecodedHashJWT
decodeHashJWT

data HashJWTClaims = HashJWTClaims
  { HashJWTClaims -> Hash32
hash :: Hash32,
    HashJWTClaims -> Maybe Text
userId :: Maybe Text
  }
  deriving stock (Int -> HashJWTClaims -> ShowS
[HashJWTClaims] -> ShowS
HashJWTClaims -> [Char]
(Int -> HashJWTClaims -> ShowS)
-> (HashJWTClaims -> [Char])
-> ([HashJWTClaims] -> ShowS)
-> Show HashJWTClaims
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashJWTClaims -> ShowS
showsPrec :: Int -> HashJWTClaims -> ShowS
$cshow :: HashJWTClaims -> [Char]
show :: HashJWTClaims -> [Char]
$cshowList :: [HashJWTClaims] -> ShowS
showList :: [HashJWTClaims] -> ShowS
Show, HashJWTClaims -> HashJWTClaims -> Bool
(HashJWTClaims -> HashJWTClaims -> Bool)
-> (HashJWTClaims -> HashJWTClaims -> Bool) -> Eq HashJWTClaims
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashJWTClaims -> HashJWTClaims -> Bool
== :: HashJWTClaims -> HashJWTClaims -> Bool
$c/= :: HashJWTClaims -> HashJWTClaims -> Bool
/= :: HashJWTClaims -> HashJWTClaims -> Bool
Eq, Eq HashJWTClaims
Eq HashJWTClaims =>
(HashJWTClaims -> HashJWTClaims -> Ordering)
-> (HashJWTClaims -> HashJWTClaims -> Bool)
-> (HashJWTClaims -> HashJWTClaims -> Bool)
-> (HashJWTClaims -> HashJWTClaims -> Bool)
-> (HashJWTClaims -> HashJWTClaims -> Bool)
-> (HashJWTClaims -> HashJWTClaims -> HashJWTClaims)
-> (HashJWTClaims -> HashJWTClaims -> HashJWTClaims)
-> Ord HashJWTClaims
HashJWTClaims -> HashJWTClaims -> Bool
HashJWTClaims -> HashJWTClaims -> Ordering
HashJWTClaims -> HashJWTClaims -> HashJWTClaims
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 :: HashJWTClaims -> HashJWTClaims -> Ordering
compare :: HashJWTClaims -> HashJWTClaims -> Ordering
$c< :: HashJWTClaims -> HashJWTClaims -> Bool
< :: HashJWTClaims -> HashJWTClaims -> Bool
$c<= :: HashJWTClaims -> HashJWTClaims -> Bool
<= :: HashJWTClaims -> HashJWTClaims -> Bool
$c> :: HashJWTClaims -> HashJWTClaims -> Bool
> :: HashJWTClaims -> HashJWTClaims -> Bool
$c>= :: HashJWTClaims -> HashJWTClaims -> Bool
>= :: HashJWTClaims -> HashJWTClaims -> Bool
$cmax :: HashJWTClaims -> HashJWTClaims -> HashJWTClaims
max :: HashJWTClaims -> HashJWTClaims -> HashJWTClaims
$cmin :: HashJWTClaims -> HashJWTClaims -> HashJWTClaims
min :: HashJWTClaims -> HashJWTClaims -> HashJWTClaims
Ord)

-- | Adding a type tag to the jwt prevents users from using jwts we issue for other things
-- in this spot. All of our jwts should have a type parameter of some kind.
hashJWTType :: String
hashJWTType :: [Char]
hashJWTType = [Char]
"hj"

instance Servant.Auth.ToJWT HashJWTClaims where
  encodeJWT :: HashJWTClaims -> ClaimsSet
encodeJWT (HashJWTClaims Hash32
h Maybe Text
u) =
    ClaimsSet
Jose.emptyClaimsSet
      ClaimsSet -> (ClaimsSet -> ClaimsSet) -> ClaimsSet
forall a b. a -> (a -> b) -> b
& Text -> Value -> ClaimsSet -> ClaimsSet
Jose.addClaim Text
"h" (Hash32 -> Value
forall a. ToJSON a => a -> Value
toJSON Hash32
h)
      ClaimsSet -> (ClaimsSet -> ClaimsSet) -> ClaimsSet
forall a b. a -> (a -> b) -> b
& Text -> Value -> ClaimsSet -> ClaimsSet
Jose.addClaim Text
"u" (Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Text
u)
      ClaimsSet -> (ClaimsSet -> ClaimsSet) -> ClaimsSet
forall a b. a -> (a -> b) -> b
& Text -> Value -> ClaimsSet -> ClaimsSet
Jose.addClaim Text
"t" ([Char] -> Value
forall a. ToJSON a => a -> Value
toJSON [Char]
hashJWTType)

instance Servant.Auth.FromJWT HashJWTClaims where
  decodeJWT :: ClaimsSet -> Either Text HashJWTClaims
decodeJWT ClaimsSet
claims = Either Text HashJWTClaims
-> (HashJWTClaims -> Either Text HashJWTClaims)
-> Maybe HashJWTClaims
-> Either Text HashJWTClaims
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text HashJWTClaims
forall a b. a -> Either a b
Left Text
"Invalid HashJWTClaims") HashJWTClaims -> Either Text HashJWTClaims
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe HashJWTClaims -> Either Text HashJWTClaims)
-> Maybe HashJWTClaims -> Either Text HashJWTClaims
forall a b. (a -> b) -> a -> b
$ do
    Hash32
hash <- ClaimsSet
claims ClaimsSet
-> Getting (First Hash32) ClaimsSet Hash32 -> Maybe Hash32
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map Text Value -> Const (First Hash32) (Map Text Value))
-> ClaimsSet -> Const (First Hash32) ClaimsSet
Lens' ClaimsSet (Map Text Value)
Jose.unregisteredClaims ((Map Text Value -> Const (First Hash32) (Map Text Value))
 -> ClaimsSet -> Const (First Hash32) ClaimsSet)
-> ((Hash32 -> Const (First Hash32) Hash32)
    -> Map Text Value -> Const (First Hash32) (Map Text Value))
-> Getting (First Hash32) ClaimsSet Hash32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text Value)
-> Traversal' (Map Text Value) (IxValue (Map Text Value))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text Value)
"h" ((Value -> Const (First Hash32) Value)
 -> Map Text Value -> Const (First Hash32) (Map Text Value))
-> ((Hash32 -> Const (First Hash32) Hash32)
    -> Value -> Const (First Hash32) Value)
-> (Hash32 -> Const (First Hash32) Hash32)
-> Map Text Value
-> Const (First Hash32) (Map Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Result Hash32) -> Fold Value Hash32
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding Value -> Result Hash32
forall a. FromJSON a => Value -> Result a
fromJSON
    Maybe Text
userId <- ClaimsSet
claims ClaimsSet
-> Getting (First (Maybe Text)) ClaimsSet (Maybe Text)
-> Maybe (Maybe Text)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map Text Value -> Const (First (Maybe Text)) (Map Text Value))
-> ClaimsSet -> Const (First (Maybe Text)) ClaimsSet
Lens' ClaimsSet (Map Text Value)
Jose.unregisteredClaims ((Map Text Value -> Const (First (Maybe Text)) (Map Text Value))
 -> ClaimsSet -> Const (First (Maybe Text)) ClaimsSet)
-> ((Maybe Text -> Const (First (Maybe Text)) (Maybe Text))
    -> Map Text Value -> Const (First (Maybe Text)) (Map Text Value))
-> Getting (First (Maybe Text)) ClaimsSet (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text Value)
-> Traversal' (Map Text Value) (IxValue (Map Text Value))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text Value)
"u" ((Value -> Const (First (Maybe Text)) Value)
 -> Map Text Value -> Const (First (Maybe Text)) (Map Text Value))
-> ((Maybe Text -> Const (First (Maybe Text)) (Maybe Text))
    -> Value -> Const (First (Maybe Text)) Value)
-> (Maybe Text -> Const (First (Maybe Text)) (Maybe Text))
-> Map Text Value
-> Const (First (Maybe Text)) (Map Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Result (Maybe Text)) -> Fold Value (Maybe Text)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding Value -> Result (Maybe Text)
forall a. FromJSON a => Value -> Result a
fromJSON
    case ClaimsSet
claims ClaimsSet
-> Getting (First [Char]) ClaimsSet [Char] -> Maybe [Char]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map Text Value -> Const (First [Char]) (Map Text Value))
-> ClaimsSet -> Const (First [Char]) ClaimsSet
Lens' ClaimsSet (Map Text Value)
Jose.unregisteredClaims ((Map Text Value -> Const (First [Char]) (Map Text Value))
 -> ClaimsSet -> Const (First [Char]) ClaimsSet)
-> (([Char] -> Const (First [Char]) [Char])
    -> Map Text Value -> Const (First [Char]) (Map Text Value))
-> Getting (First [Char]) ClaimsSet [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text Value)
-> Traversal' (Map Text Value) (IxValue (Map Text Value))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text Value)
"t" ((Value -> Const (First [Char]) Value)
 -> Map Text Value -> Const (First [Char]) (Map Text Value))
-> (([Char] -> Const (First [Char]) [Char])
    -> Value -> Const (First [Char]) Value)
-> ([Char] -> Const (First [Char]) [Char])
-> Map Text Value
-> Const (First [Char]) (Map Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Result [Char]) -> Fold Value [Char]
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding Value -> Result [Char]
forall a. FromJSON a => Value -> Result a
fromJSON of
      Just [Char]
t | [Char]
t [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
hashJWTType -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Maybe [Char]
_ -> Maybe ()
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty
    HashJWTClaims -> Maybe HashJWTClaims
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashJWTClaims {Maybe Text
Hash32
$sel:hash:HashJWTClaims :: Hash32
$sel:userId:HashJWTClaims :: Maybe Text
hash :: Hash32
userId :: Maybe Text
..}

instance ToJSON HashJWTClaims where
  toJSON :: HashJWTClaims -> Value
toJSON (HashJWTClaims Hash32
hash Maybe Text
userId) =
    [Pair] -> Value
object
      [ Key
"h" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
hash,
        Key
"u" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
userId
      ]

instance FromJSON HashJWTClaims where
  parseJSON :: Value -> Parser HashJWTClaims
parseJSON = [Char]
-> (Object -> Parser HashJWTClaims)
-> Value
-> Parser HashJWTClaims
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"HashJWTClaims" \Object
obj -> do
    Hash32
hash <- Object
obj Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"h"
    Maybe Text
userId <- Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"u"
    HashJWTClaims -> Parser HashJWTClaims
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashJWTClaims {Maybe Text
Hash32
$sel:hash:HashJWTClaims :: Hash32
$sel:userId:HashJWTClaims :: Maybe Text
hash :: Hash32
userId :: Maybe Text
..}

-- | A decoded hash JWT that retains the original encoded JWT.
data DecodedHashJWT = DecodedHashJWT
  { DecodedHashJWT -> HashJWTClaims
claims :: HashJWTClaims,
    DecodedHashJWT -> HashJWT
hashJWT :: HashJWT
  }
  deriving (DecodedHashJWT -> DecodedHashJWT -> Bool
(DecodedHashJWT -> DecodedHashJWT -> Bool)
-> (DecodedHashJWT -> DecodedHashJWT -> Bool) -> Eq DecodedHashJWT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodedHashJWT -> DecodedHashJWT -> Bool
== :: DecodedHashJWT -> DecodedHashJWT -> Bool
$c/= :: DecodedHashJWT -> DecodedHashJWT -> Bool
/= :: DecodedHashJWT -> DecodedHashJWT -> Bool
Eq, Eq DecodedHashJWT
Eq DecodedHashJWT =>
(DecodedHashJWT -> DecodedHashJWT -> Ordering)
-> (DecodedHashJWT -> DecodedHashJWT -> Bool)
-> (DecodedHashJWT -> DecodedHashJWT -> Bool)
-> (DecodedHashJWT -> DecodedHashJWT -> Bool)
-> (DecodedHashJWT -> DecodedHashJWT -> Bool)
-> (DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT)
-> (DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT)
-> Ord DecodedHashJWT
DecodedHashJWT -> DecodedHashJWT -> Bool
DecodedHashJWT -> DecodedHashJWT -> Ordering
DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT
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 :: DecodedHashJWT -> DecodedHashJWT -> Ordering
compare :: DecodedHashJWT -> DecodedHashJWT -> Ordering
$c< :: DecodedHashJWT -> DecodedHashJWT -> Bool
< :: DecodedHashJWT -> DecodedHashJWT -> Bool
$c<= :: DecodedHashJWT -> DecodedHashJWT -> Bool
<= :: DecodedHashJWT -> DecodedHashJWT -> Bool
$c> :: DecodedHashJWT -> DecodedHashJWT -> Bool
> :: DecodedHashJWT -> DecodedHashJWT -> Bool
$c>= :: DecodedHashJWT -> DecodedHashJWT -> Bool
>= :: DecodedHashJWT -> DecodedHashJWT -> Bool
$cmax :: DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT
max :: DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT
$cmin :: DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT
min :: DecodedHashJWT -> DecodedHashJWT -> DecodedHashJWT
Ord, Int -> DecodedHashJWT -> ShowS
[DecodedHashJWT] -> ShowS
DecodedHashJWT -> [Char]
(Int -> DecodedHashJWT -> ShowS)
-> (DecodedHashJWT -> [Char])
-> ([DecodedHashJWT] -> ShowS)
-> Show DecodedHashJWT
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodedHashJWT -> ShowS
showsPrec :: Int -> DecodedHashJWT -> ShowS
$cshow :: DecodedHashJWT -> [Char]
show :: DecodedHashJWT -> [Char]
$cshowList :: [DecodedHashJWT] -> ShowS
showList :: [DecodedHashJWT] -> ShowS
Show)

-- | Decode a hash JWT.
decodeHashJWT :: HashJWT -> DecodedHashJWT
decodeHashJWT :: HashJWT -> DecodedHashJWT
decodeHashJWT HashJWT
hashJWT =
  DecodedHashJWT
    { $sel:claims:DecodedHashJWT :: HashJWTClaims
claims = HashJWT -> HashJWTClaims
decodeHashJWTClaims HashJWT
hashJWT,
      HashJWT
$sel:hashJWT:DecodedHashJWT :: HashJWT
hashJWT :: HashJWT
hashJWT
    }

-- | Decode the claims out of a hash JWT.
decodeHashJWTClaims :: HashJWT -> HashJWTClaims
decodeHashJWTClaims :: HashJWT -> HashJWTClaims
decodeHashJWTClaims (HashJWT Text
text) =
  case Text -> Maybe (JWT UnverifiedJWT)
JWT.decode Text
text of
    Maybe (JWT UnverifiedJWT)
Nothing -> [Char] -> HashJWTClaims
forall a. HasCallStack => [Char] -> a
error [Char]
"bad JWT"
    Just JWT UnverifiedJWT
jwt ->
      let object :: Value
object =
            JWT UnverifiedJWT
jwt
              JWT UnverifiedJWT
-> (JWT UnverifiedJWT -> JWTClaimsSet) -> JWTClaimsSet
forall a b. a -> (a -> b) -> b
& JWT UnverifiedJWT -> JWTClaimsSet
forall r. JWT r -> JWTClaimsSet
JWT.claims
              JWTClaimsSet -> (JWTClaimsSet -> ClaimsMap) -> ClaimsMap
forall a b. a -> (a -> b) -> b
& JWTClaimsSet -> ClaimsMap
JWT.unregisteredClaims
              ClaimsMap -> (ClaimsMap -> Map Text Value) -> Map Text Value
forall a b. a -> (a -> b) -> b
& ClaimsMap -> Map Text Value
JWT.unClaimsMap
              Map Text Value -> (Map Text Value -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Map Text Value -> Object
forall v. Map Text v -> KeyMap v
Aeson.KeyMap.fromMapText
              Object -> (Object -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Object -> Value
Aeson.Object
       in case Value -> Result HashJWTClaims
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
object of
            Aeson.Error [Char]
err -> [Char] -> HashJWTClaims
forall a. HasCallStack => [Char] -> a
error ([Char]
"bad JWT: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err)
            Aeson.Success HashJWTClaims
claims -> HashJWTClaims
claims

-- | Grab the hash out of a decoded hash JWT.
decodedHashJWTHash :: DecodedHashJWT -> Hash32
decodedHashJWTHash :: DecodedHashJWT -> Hash32
decodedHashJWTHash DecodedHashJWT {$sel:claims:DecodedHashJWT :: DecodedHashJWT -> HashJWTClaims
claims = HashJWTClaims {Hash32
$sel:hash:HashJWTClaims :: HashJWTClaims -> Hash32
hash :: Hash32
hash}} =
  Hash32
hash