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
  56 verify :: MonadIO m => Key -> [Caveat -> m (Maybe (Either ValidationError Caveat))] -> Macaroon -> m (Either ValidationError Macaroon)
  57 verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers)
  58
  59
  60 -- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat))
  61 -- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do
  62 --     expected <- val
  63 --     return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s)
  64 --   where
  65 --     valueParser = string op *> skipSpace *> takeByteString
  66
  67 verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat))
  68 verifyParser k p f c = case parseOnly keyParser . cid $ c of
  69     Left _ -> return Nothing
  70     Right bs -> Just <$> case parseOnly p bs of
  71       Left err -> return $ Left $ ParseError err
  72       Right a -> fmap (const c) <$> f a
  73   where
  74     keyParser = string k *> skipSpace *> takeByteString
  75