hopenpgp-tools-0.11: HOpenPGP/Tools/Parser.y

{
{-# OPTIONS -w #-}
module HOpenPGP.Tools.Parser( parseExpr, readExpr ) where
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Filter (Expr(..), UPredicate(..), UOp(..), OVar(..), OValue(..), SPVar(..), SPValue(..), PKPVar(..), PKPValue(..))
import HOpenPGP.Tools.Lexer
}

%name parse
%tokentype { Token }
%monad { Alex }
%lexer { lexwrap } { TokenEOF }
%error { happyError }
%token
    and { TokenAnd }
    any { TokenAny }
    not { TokenNot }
    or { TokenOr }
    tag { TokenTag }
    int { TokenInt $$ }
    '=' { TokenEq }
    '<' { TokenLt }
    '>' { TokenGt }
    '(' { TokenLParen }
    ')' { TokenRParen }
    pkversion { TokenPKVersion }
    sigversion { TokenSigVersion }
    sigtype { TokenSigType }
    pkalgo { TokenPKAlgo }
    sigpkalgo { TokenSigPKAlgo }
    hashalgo { TokenHashAlgo }
    rsa { TokenRSA }
    dsa { TokenDSA }
    elgamal { TokenElgamal }
    ecdsa { TokenECDSA }
    ecdh { TokenECDH }
    dh { TokenDH }
    binary { TokenBinary }
    canonicaltext { TokenCanonicalText }
    standalone { TokenStandalone }
    genericcert { TokenGenericCert }
    personacert { TokenPersonaCert }
    casualcert { TokenCasualCert }
    positivecert { TokenPositiveCert }
    subkeybindingsig { TokenSubkeyBindingSig }
    primarykeybindingsig { TokenPrimaryKeyBindingSig }
    signaturedirectlyonakey { TokenSignatureDirectlyOnAKey }
    keyrevocationsig { TokenKeyRevocationSig }
    subkeyrevocationsig { TokenSubkeyRevocationSig }
    certrevocationsig { TokenCertRevocationSig }
    timestampsig { TokenTimestampSig }
    md5 { TokenMD5 }
    sha1 { TokenSHA1 }
    ripemd160 { TokenRIPEMD160 }
    sha256 { TokenSHA256 }
    sha384 { TokenSHA384 }
    sha512 { TokenSHA512 }
    sha224 { TokenSHA224 }
    keysize { TokenKeysize }
    timestamp { TokenTimestamp }
    fingerprint { TokenFingerprint }
    keyid { TokenKeyID }
    fpr { TokenFpr $$ }
    longid { TokenLongID $$ }
    length { TokenLength }

%%

Expr : any { EAny }
     | not Expr { ENot $2 }
     | OExpr { E $1 }
     | SPExpr { E $1 }
     | PKPExpr { E $1 }
     | Expr and Expr { EAnd $1 $3 }
     | Expr or Expr { EOr $1 $3 }

OExpr : tag Op Val { UOP OVTag $2 $3 }
      | length Op Val { UOP OVLength $2 $3 }

SPExpr : sigversion Op SPVal { USPP SPVVersion $2 $3 }
       | sigtype Op SPVsigtypes { USPP SPVSigType $2 $3 }
       | sigpkalgo Op SPVpkalgos { USPP SPVPKA $2 $3 }
       | hashalgo Op SPVhashalgos { USPP SPVHA $2 $3 }

PKPExpr : pkversion Op PKPVal { UPKPP PKPVVersion $2 $3 }
        | pkalgo Op PKPVpkalgos { UPKPP PKPVPKA $2 $3 }
        | keysize Op PKPVal { UPKPP PKPVKeysize $2 $3 }
        | timestamp Op PKPVal { UPKPP PKPVTimestamp $2 $3 }
        | fingerprint Op PKPVfingerprint { UPKPP PKPVTOF $2 $3 }
        | keyid Op PKPVlongid { UPKPP PKPVEOKI $2 $3 }

Op : '=' { UEquals }
   | '<' { ULessThan }
   | '>' { UGreaterThan }

Val : int { OInt $1 }

SPVal : int { SPInt $1 }

SPVsigtypes : binary { SPSigType BinarySig }
            | canonicaltext { SPSigType CanonicalTextSig }
            | standalone { SPSigType StandaloneSig }
            | genericcert { SPSigType GenericCert }
            | personacert { SPSigType PersonaCert }
            | casualcert { SPSigType CasualCert }
            | positivecert { SPSigType PositiveCert }
            | subkeybindingsig { SPSigType SubkeyBindingSig }
            | primarykeybindingsig { SPSigType PrimaryKeyBindingSig }
            | signaturedirectlyonakey { SPSigType SignatureDirectlyOnAKey }
            | keyrevocationsig { SPSigType KeyRevocationSig }
            | subkeyrevocationsig { SPSigType SubkeyRevocationSig }
            | certrevocationsig { SPSigType CertRevocationSig }
            | timestampsig { SPSigType TimestampSig }
            | int { SPInt $1 }

SPVpkalgos : rsa { SPPKA RSA }
           | dsa { SPPKA DSA }
           | elgamal { SPPKA ElgamalEncryptOnly }
           | ecdsa { SPPKA ECDSA }
           | ecdh { SPPKA ECDH }
           | dh { SPPKA DH }
           | int { SPInt $1 }

SPVhashalgos : md5 { SPHA DeprecatedMD5 }
             | sha1 { SPHA SHA1 }
             | ripemd160 { SPHA RIPEMD160 }
             | sha256 { SPHA SHA256 }
             | sha384 { SPHA SHA384 }
             | sha512 { SPHA SHA512 }
             | sha224 { SPHA SHA224 }
             | int { SPInt $1 }

PKPVal : int { PKPInt $1 }

PKPVpkalgos : rsa { PKPPKA RSA }
            | dsa { PKPPKA DSA }
            | elgamal { PKPPKA ElgamalEncryptOnly }
            | ecdsa { PKPPKA ECDSA }
            | ecdh { PKPPKA ECDH }
            | dh { PKPPKA DH }
            | int { PKPInt $1 }

PKPVfingerprint : fpr { PKPTOF $1 }

PKPVlongid : longid { PKPEOKI $1 }

{
lexwrap :: (Token -> Alex a) -> Alex a
lexwrap cont = do
    t <- alexMonadScan'
    cont t

alexMonadScan' = do
    inp <- alexGetInput
    sc <- alexGetStartCode
    case alexScan inp sc of
        AlexEOF -> alexEOF
        AlexError (pos, _, _, _) -> alexError (show pos)
        AlexSkip inp' len -> do
            alexSetInput inp'
            alexMonadScan'
        AlexToken inp' len action -> do
            alexSetInput inp'
            action (ignorePendingBytes inp) len

getPosn :: Alex (Int,Int)
getPosn = do
    (AlexPn _ l c,_,_,_) <- alexGetInput
    return (l,c)

happyError :: Token -> Alex a
happyError t = do
    (l,c) <- getPosn
    fail (show l ++ ":" ++ show c ++ ": Parse error on Token: " ++ show t ++ "\n")

parseExpr :: String -> Either String (Expr UPredicate)
parseExpr s = runAlex s parse

readExpr :: FilePath -> IO (Either String (Expr UPredicate))
readExpr fp = do
    cs <- readFile fp
    return (parseExpr cs)
}