asn1-ber-syntax-0.1.0.0: test/Message.hs

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NamedFieldPuns #-}

module Message
  ( resolveMessage
  , Message(..)
  ) where

import Prelude hiding (sequence)

import Asn.Oid (Oid)
import Asn.Resolve

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 :: Value -> Parser 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, fmap GetRequest . aPdu)
    , (ContextSpecific, 1, fmap GetNextRequest . aPdu)
    -- , (ContextSpecific, 2, fmap GetBulkRequest . bulkPdus) -- TODO
    , (ContextSpecific, 3, fmap Response . aPdu)
    , (ContextSpecific, 4, fmap SetRequest . aPdu)
    , (ContextSpecific, 5, fmap InformRequest . aPdu)
    , (ContextSpecific, 6, fmap SnmpV2Trap . aPdu)
    , (ContextSpecific, 7, fmap Report . aPdu)
    ]
  aPdu :: Value -> Parser APdu
  aPdu = sequence $ do
    requestId <- index 0 integer
    errorStatus <- index 1 integer
    errorIndex <- index 2 integer
    varBinds <- index 3 $ sequenceOf $ sequence $ do
      name <- index 0 oid
      result <- index 1 varBind
      pure VarBind{name,result}
    pure Pdu{requestId,errorStatus,errorIndex,varBinds}
  varBind :: Value -> Parser VarBindResult
  varBind = chooseTag
    [(Application, 1, fmap (Value . CounterValue) . integer)]
    -- TODO