src/Crypto/Macaroon/Verifier.hs

   1 {-# LANGUAGE FlexibleInstances    #-}
   2 {-# LANGUAGE OverloadedStrings    #-}
   3 {-# LANGUAGE RankNTypes           #-}
   4 {-# LANGUAGE TypeSynonymInstances #-}
   5 {-# LANGUAGE UndecidableInstances #-}
   6 {-|
   7 Module      : Crypto.Macaroon.Verifier
   8 Copyright   : (c) 2015 Julien Tanguy
   9 License     : BSD3
  10
  11 Maintainer  : julien.tanguy@jhome.fr
  12 Stability   : experimental
  13 Portability : portable
  14
  15
  16
  17 -}
  18 module Crypto.Macaroon.Verifier (
  19     verify
  20   , ValidationError(ValidatorError, ParseError)
  21   -- , (.<), (.<=), (.==), (.>), (.>=)
  22   -- , module Data.Attoparsec.ByteString.Char8
  23 ) where
  24
  25
  26 import           Control.Monad
  27 import           Control.Monad.IO.Class
  28 import           Data.Attoparsec.ByteString
  29 import           Data.Attoparsec.ByteString.Char8
  30 import           Data.Bool
  31 import qualified Data.ByteString                  as BS
  32 import           Data.Either.Combinators
  33
  34 import           Crypto.Macaroon.Internal
  35 import           Crypto.Macaroon.Verifier.Internal
  36
  37
  38
  39
  40 -- (.<) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  41 -- (.<) = verifyOpBool "Greater or equal" (<) "<"
  42
  43 -- (.<=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  44 -- (.<=) = verifyOpBool "Strictly greater" (<=) "<="
  45
  46 -- (.==) :: (MonadIO m, Eq a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  47 -- (.==) = verifyOpBool "Not equal" (==) "="
  48
  49 -- (.>) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  50 -- (.>) = verifyOpBool "Less or equal" (>) ">"
  51
  52 -- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  53 -- (.>=) = verifyOpBool "Strictly less" (>=) ">="
  54
  55 -- | Verify a Macaroon's signature and caveats, given the corresponding Secret
  56 -- and verifiers.
  57 --
  58 -- A verifier is a function of type
  59 -- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@.
  60 --
  61 -- It should return:
  62 --
  63 -- * 'Nothing' if the caveat is not related to the verifier
  64 -- (for instance a time verifier is given an action caveat);
  65 -- * 'Just' ('Left' ('ParseError' reason)) if the verifier  is related to the
  66 -- caveat, but failed to parse it completely;
  67 -- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the
  68 -- caveat, parsed it and invalidated it;
  69 -- * 'Just' ('Right' '()') if the verifier has successfully verified the
  70 -- given caveat
  71 verify :: MonadIO m => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon)
  72 verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers)
  73
  74
  75 -- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  76 -- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do
  77 --     expected <- val
  78 --     return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s)
  79 --   where
  80 --     valueParser = string op *> skipSpace *> takeByteString
  81
  82 -- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat))
  83 -- verifyParser k p f c = case parseOnly keyParser . cid $ c of
  84 --     Left _ -> return Nothing
  85 --     Right bs -> Just <$> case parseOnly p bs of
  86 --       Left err -> return $ Left $ ParseError err
  87 --       Right a -> fmap (const c) <$> f a
  88 --   where
  89 --     keyParser = string k *> skipSpace *> takeByteString
  90