{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE NamedFieldPuns #-} module Message.Category ( resolveMessage , Message(..) ) where import Prelude hiding (sequence) import Asn.Oid (Oid) import Asn.Resolve.Category import Data.Bytes (Bytes) import Data.Int (Int64) import Data.Primitive (SmallArray) data Message = Message { version :: Int64 , community :: {-# UNPACK #-} !Bytes , pdu :: Pdu } deriving(Show) data Pdu = GetRequest APdu | GetNextRequest APdu | Response APdu | SetRequest APdu | InformRequest APdu | SnmpV2Trap APdu | Report APdu deriving(Show) data APdu = Pdu { requestId :: Int64 , errorStatus :: Int64 , errorIndex :: Int64 , varBinds :: SmallArray VarBind } deriving(Show) data VarBind = VarBind { name :: !Oid , result :: VarBindResult } deriving(Show) data VarBindResult = Value ObjectSyntax | Unspecified | NoSuchObject | NoSuchInstance | EndOfMibView deriving(Show) data ObjectSyntax = IntegerValue !Int64 | StringValue Bytes | ObjectIdValue !Oid | IpAddressValue Bytes | CounterValue Int64 | TimeticksValue Int64 | ArbitraryValue Bytes | BigCounterValue Int64 | UnsignedIntegerValue Int64 deriving(Show) resolveMessage :: Value -> Either Path Message resolveMessage = run message message :: Parser Value Message message = sequence >-> do version <- index 0 >-> integer community <- index 1 >-> octetString pdu <- index 2 >-> resolvePdu pure Message{version,community,pdu} where resolvePdu = chooseTag [ (ContextSpecific, 0, GetRequest <$> aPdu) , (ContextSpecific, 1, GetNextRequest <$> aPdu) -- , (ContextSpecific, 2, GetBulkRequest <$> bulkPdus) -- TODO , (ContextSpecific, 3, Response <$> aPdu) , (ContextSpecific, 4, SetRequest <$> aPdu) , (ContextSpecific, 5, InformRequest <$> aPdu) , (ContextSpecific, 6, SnmpV2Trap <$> aPdu) , (ContextSpecific, 7, Report <$> aPdu) ] aPdu :: Parser Value APdu aPdu = sequence >-> do requestId <- index 0 >-> integer errorStatus <- index 1 >-> integer errorIndex <- index 2 >-> integer varBinds <- index 3 >-> sequenceOf (sequence >-> varBind) pure Pdu{requestId,errorStatus,errorIndex,varBinds} varBind :: Parser (SmallArray Value) VarBind varBind = do name <- index 0 >-> oid result <- index 1 >-> varBindResult pure VarBind{name,result} varBindResult :: Parser Value VarBindResult varBindResult = chooseTag [(Application, 1, (Value . CounterValue) <$> integer)] -- TODO