module Authorize.Macaroon.Verify (
    VerificationFailure (..),
    verify,
    recalcSignature,
) where

import Authorize.Macaroon.Crypto (
    bindForRequest,
    createSignature,
    decryptKey,
    deriveKey,
    updateSignature,
 )
import Authorize.Macaroon.Types (
    Caveat (Caveat),
    Key,
    KeyId,
    Macaroon (..),
    MacaroonId (MacaroonId),
    SealedMacaroon (SealedMacaroon),
    Signature,
 )
import Control.Arrow ((&&&))
import Control.Monad (foldM, unless)
import Data.ByteArray (constEq)
import Data.ByteString (ByteString)
import Data.Foldable (foldl')
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set

data VerificationFailure
    = InvalidSignature MacaroonId
    | InvalidBinding MacaroonId
    | MissingDischargeMacaroon MacaroonId
    | ExcessDischarges [Macaroon]
    | ThirdPartyKeyError MacaroonId
    deriving (VerificationFailure -> VerificationFailure -> Bool
(VerificationFailure -> VerificationFailure -> Bool)
-> (VerificationFailure -> VerificationFailure -> Bool)
-> Eq VerificationFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationFailure -> VerificationFailure -> Bool
== :: VerificationFailure -> VerificationFailure -> Bool
$c/= :: VerificationFailure -> VerificationFailure -> Bool
/= :: VerificationFailure -> VerificationFailure -> Bool
Eq, Int -> VerificationFailure -> ShowS
[VerificationFailure] -> ShowS
VerificationFailure -> String
(Int -> VerificationFailure -> ShowS)
-> (VerificationFailure -> String)
-> ([VerificationFailure] -> ShowS)
-> Show VerificationFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationFailure -> ShowS
showsPrec :: Int -> VerificationFailure -> ShowS
$cshow :: VerificationFailure -> String
show :: VerificationFailure -> String
$cshowList :: [VerificationFailure] -> ShowS
showList :: [VerificationFailure] -> ShowS
Show)

type Discharges = Map MacaroonId Macaroon

-- | Macaroon verification succeeds by producing a set of first party caveats
-- requiring further validation.
verify ::
    -- | root key
    Key ->
    SealedMacaroon ->
    Either VerificationFailure (Set ByteString)
verify :: Key
-> SealedMacaroon -> Either VerificationFailure (Set ByteString)
verify Key
rootKey (SealedMacaroon Macaroon
m [Macaroon]
ms) = do
    (Set ByteString
cs, Discharges
ds') <- Key
-> Macaroon
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verify' (Key -> Key
deriveKey Key
rootKey) Macaroon
m Discharges
ds
    Bool
-> Either VerificationFailure () -> Either VerificationFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Discharges -> Bool
forall k a. Map k a -> Bool
Map.null Discharges
ds') (Either VerificationFailure () -> Either VerificationFailure ())
-> Either VerificationFailure () -> Either VerificationFailure ()
forall a b. (a -> b) -> a -> b
$ VerificationFailure -> Either VerificationFailure ()
forall a b. a -> Either a b
Left ([Macaroon] -> VerificationFailure
ExcessDischarges ([Macaroon] -> VerificationFailure)
-> [Macaroon] -> VerificationFailure
forall a b. (a -> b) -> a -> b
$ Discharges -> [Macaroon]
forall k a. Map k a -> [a]
Map.elems Discharges
ds')
    Set ByteString -> Either VerificationFailure (Set ByteString)
forall a. a -> Either VerificationFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return Set ByteString
cs
  where
    ds :: Discharges
ds = [(MacaroonId, Macaroon)] -> Discharges
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(MacaroonId, Macaroon)] -> Discharges)
-> [(MacaroonId, Macaroon)] -> Discharges
forall a b. (a -> b) -> a -> b
$ (Macaroon -> MacaroonId
identifier (Macaroon -> MacaroonId)
-> (Macaroon -> Macaroon) -> Macaroon -> (MacaroonId, Macaroon)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Macaroon -> Macaroon
forall a. a -> a
id) (Macaroon -> (MacaroonId, Macaroon))
-> [Macaroon] -> [(MacaroonId, Macaroon)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Macaroon]
ms

verify' ::
    Key ->
    Macaroon ->
    Discharges ->
    Either VerificationFailure (Set ByteString, Discharges)
verify' :: Key
-> Macaroon
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verify' Key
k Macaroon
m Discharges
ds = (Signature, Set ByteString, Discharges)
-> Either VerificationFailure (Set ByteString, Discharges)
forall {bs1} {a} {b}.
ByteArrayAccess bs1 =>
(bs1, a, b) -> Either VerificationFailure (a, b)
checkSig ((Signature, Set ByteString, Discharges)
 -> Either VerificationFailure (Set ByteString, Discharges))
-> Either
     VerificationFailure (Signature, Set ByteString, Discharges)
-> Either VerificationFailure (Set ByteString, Discharges)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Signature, Set ByteString, Discharges)
 -> Caveat
 -> Either
      VerificationFailure (Signature, Set ByteString, Discharges))
-> (Signature, Set ByteString, Discharges)
-> [Caveat]
-> Either
     VerificationFailure (Signature, Set ByteString, Discharges)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Signature, Set ByteString, Discharges)
-> Caveat
-> Either
     VerificationFailure (Signature, Set ByteString, Discharges)
step (Signature
sig0, Set ByteString
forall a. Monoid a => a
mempty, Discharges
ds) (Macaroon -> [Caveat]
caveats Macaroon
m)
  where
    step :: (Signature, Set ByteString, Discharges)
-> Caveat
-> Either
     VerificationFailure (Signature, Set ByteString, Discharges)
step (Signature
sig, Set ByteString
cs, Discharges
ds') (Caveat ByteString
_ Maybe KeyId
mk ByteString
c) =
        Maybe KeyId
-> ByteString
-> Signature
-> (Set ByteString, Discharges)
-> (Signature, Set ByteString, Discharges)
forall {b} {c}.
Maybe KeyId
-> ByteString -> Signature -> (b, c) -> (Signature, b, c)
updateSig Maybe KeyId
mk ByteString
c Signature
sig ((Set ByteString, Discharges)
 -> (Signature, Set ByteString, Discharges))
-> Either VerificationFailure (Set ByteString, Discharges)
-> Either
     VerificationFailure (Signature, Set ByteString, Discharges)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString
 -> Set ByteString
 -> Discharges
 -> Either VerificationFailure (Set ByteString, Discharges))
-> (KeyId
    -> ByteString
    -> Set ByteString
    -> Discharges
    -> Either VerificationFailure (Set ByteString, Discharges))
-> Maybe KeyId
-> ByteString
-> Set ByteString
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
-> Set ByteString
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
forall {m :: * -> *} {a} {b}.
(Monad m, Ord a) =>
a -> Set a -> b -> m (Set a, b)
firstP (Signature
-> KeyId
-> ByteString
-> Set ByteString
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verThirdP Signature
sig) Maybe KeyId
mk ByteString
c Set ByteString
cs Discharges
ds'

    firstP :: a -> Set a -> b -> m (Set a, b)
firstP a
c Set a
cs b
ds' = (Set a, b) -> m (Set a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Set a
forall a. a -> Set a
Set.singleton a
c Set a -> Set a -> Set a
forall a. Semigroup a => a -> a -> a
<> Set a
cs, b
ds')
    verThirdP :: Signature
-> KeyId
-> ByteString
-> Set ByteString
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verThirdP = Signature
-> Signature
-> KeyId
-> ByteString
-> Set ByteString
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verifyThirdParty (Macaroon -> Signature
macaroonSignature Macaroon
m)

    sig0 :: Signature
sig0 = Key -> MacaroonId -> Signature
createSignature Key
k (Macaroon -> MacaroonId
identifier Macaroon
m)
    updateSig :: Maybe KeyId
-> ByteString -> Signature -> (b, c) -> (Signature, b, c)
updateSig Maybe KeyId
mk ByteString
c Signature
sig (b
x, c
y) = (Signature -> Maybe KeyId -> ByteString -> Signature
updateSignature Signature
sig Maybe KeyId
mk ByteString
c, b
x, c
y)

    checkSig :: (bs1, a, b) -> Either VerificationFailure (a, b)
checkSig (bs1
sig, a
cs', b
ds') =
        (a
cs', b
ds')
            (a, b)
-> Either VerificationFailure ()
-> Either VerificationFailure (a, b)
forall a b.
a -> Either VerificationFailure b -> Either VerificationFailure a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool
-> Either VerificationFailure () -> Either VerificationFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
                (bs1
sig bs1 -> Signature -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` Macaroon -> Signature
macaroonSignature Macaroon
m)
                (VerificationFailure -> Either VerificationFailure ()
forall a b. a -> Either a b
Left (VerificationFailure -> Either VerificationFailure ())
-> (MacaroonId -> VerificationFailure)
-> MacaroonId
-> Either VerificationFailure ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MacaroonId -> VerificationFailure
InvalidSignature (MacaroonId -> Either VerificationFailure ())
-> MacaroonId -> Either VerificationFailure ()
forall a b. (a -> b) -> a -> b
$ Macaroon -> MacaroonId
identifier Macaroon
m)

verifyThirdParty ::
    -- | root signature
    Signature ->
    -- | running signature
    Signature ->
    KeyId ->
    ByteString ->
    Set ByteString ->
    Discharges ->
    Either VerificationFailure (Set ByteString, Discharges)
verifyThirdParty :: Signature
-> Signature
-> KeyId
-> ByteString
-> Set ByteString
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verifyThirdParty Signature
rootSig Signature
runningSig KeyId
k ByteString
c Set ByteString
acc Discharges
ds = do
    (Macaroon
m, Discharges
ds') <- MacaroonId
-> Discharges -> Either VerificationFailure (Macaroon, Discharges)
getDischarge (ByteString -> MacaroonId
MacaroonId ByteString
c) Discharges
ds
    Key
k' <- MacaroonId -> Signature -> KeyId -> Either VerificationFailure Key
getKey (Macaroon -> MacaroonId
identifier Macaroon
m) Signature
runningSig KeyId
k

    let unboundSig :: Signature
unboundSig = Key -> MacaroonId -> [Caveat] -> Signature
recalcSignature Key
k' (Macaroon -> MacaroonId
identifier Macaroon
m) (Macaroon -> [Caveat]
caveats Macaroon
m)
        dischargeSig :: Signature
dischargeSig = Macaroon -> Signature
macaroonSignature Macaroon
m
        unboundDischarge :: Macaroon
unboundDischarge = Macaroon
m{macaroonSignature = unboundSig}

    Bool
-> Either VerificationFailure () -> Either VerificationFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Signature -> Signature -> Signature
bindForRequest Signature
rootSig Signature
unboundSig Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signature
dischargeSig) (Either VerificationFailure () -> Either VerificationFailure ())
-> Either VerificationFailure () -> Either VerificationFailure ()
forall a b. (a -> b) -> a -> b
$
        VerificationFailure -> Either VerificationFailure ()
forall a b. a -> Either a b
Left (MacaroonId -> VerificationFailure
InvalidBinding (MacaroonId -> VerificationFailure)
-> MacaroonId -> VerificationFailure
forall a b. (a -> b) -> a -> b
$ Macaroon -> MacaroonId
identifier Macaroon
m)

    (Set ByteString
acc', Discharges
ds'') <- Key
-> Macaroon
-> Discharges
-> Either VerificationFailure (Set ByteString, Discharges)
verify' Key
k' Macaroon
unboundDischarge Discharges
ds'
    (Set ByteString, Discharges)
-> Either VerificationFailure (Set ByteString, Discharges)
forall a. a -> Either VerificationFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ByteString
acc' Set ByteString -> Set ByteString -> Set ByteString
forall a. Semigroup a => a -> a -> a
<> Set ByteString
acc, Discharges
ds'')

getDischarge ::
    MacaroonId ->
    Discharges ->
    Either VerificationFailure (Macaroon, Discharges)
getDischarge :: MacaroonId
-> Discharges -> Either VerificationFailure (Macaroon, Discharges)
getDischarge MacaroonId
mid Discharges
ds = Either VerificationFailure (Macaroon, Discharges)
-> (Macaroon -> Either VerificationFailure (Macaroon, Discharges))
-> Maybe Macaroon
-> Either VerificationFailure (Macaroon, Discharges)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either VerificationFailure (Macaroon, Discharges)
forall {b}. Either VerificationFailure b
noDischarge Macaroon -> Either VerificationFailure (Macaroon, Discharges)
forall {m :: * -> *} {a}. Monad m => a -> m (a, Discharges)
someDischarge (Maybe Macaroon
 -> Either VerificationFailure (Macaroon, Discharges))
-> Maybe Macaroon
-> Either VerificationFailure (Macaroon, Discharges)
forall a b. (a -> b) -> a -> b
$ MacaroonId -> Discharges -> Maybe Macaroon
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup MacaroonId
mid Discharges
ds
  where
    someDischarge :: a -> m (a, Discharges)
someDischarge a
m = (a, Discharges) -> m (a, Discharges)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
m, MacaroonId -> Discharges -> Discharges
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete MacaroonId
mid Discharges
ds)
    noDischarge :: Either VerificationFailure b
noDischarge = VerificationFailure -> Either VerificationFailure b
forall a b. a -> Either a b
Left (VerificationFailure -> Either VerificationFailure b)
-> VerificationFailure -> Either VerificationFailure b
forall a b. (a -> b) -> a -> b
$ MacaroonId -> VerificationFailure
MissingDischargeMacaroon MacaroonId
mid

getKey :: MacaroonId -> Signature -> KeyId -> Either VerificationFailure Key
getKey :: MacaroonId -> Signature -> KeyId -> Either VerificationFailure Key
getKey MacaroonId
mid Signature
sig = Either VerificationFailure Key
-> (Key -> Either VerificationFailure Key)
-> Maybe Key
-> Either VerificationFailure Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either VerificationFailure Key
forall {b}. Either VerificationFailure b
noKey Key -> Either VerificationFailure Key
forall a. a -> Either VerificationFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Key -> Either VerificationFailure Key)
-> (KeyId -> Maybe Key) -> KeyId -> Either VerificationFailure Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> KeyId -> Maybe Key
decryptKey Signature
sig
  where
    noKey :: Either VerificationFailure b
noKey = VerificationFailure -> Either VerificationFailure b
forall a b. a -> Either a b
Left (VerificationFailure -> Either VerificationFailure b)
-> VerificationFailure -> Either VerificationFailure b
forall a b. (a -> b) -> a -> b
$ MacaroonId -> VerificationFailure
ThirdPartyKeyError MacaroonId
mid

recalcSignature :: Key -> MacaroonId -> [Caveat] -> Signature
recalcSignature :: Key -> MacaroonId -> [Caveat] -> Signature
recalcSignature Key
k MacaroonId
i = (Signature -> Caveat -> Signature)
-> Signature -> [Caveat] -> Signature
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Signature -> Caveat -> Signature
step (Key -> MacaroonId -> Signature
createSignature Key
k MacaroonId
i)
  where
    step :: Signature -> Caveat -> Signature
step Signature
sig (Caveat ByteString
_ Maybe KeyId
mk ByteString
c) = Signature -> Maybe KeyId -> ByteString -> Signature
updateSignature Signature
sig Maybe KeyId
mk ByteString
c