silvi 0.0.2 → 0.0.3
raw patch · 5 files changed
+158/−145 lines, 5 filesdep ~savage
Dependency ranges changed: savage
Files
- silvi.cabal +4/−4
- src/Silvi/LogFormat.hs +34/−0
- src/Silvi/Random.hs +67/−54
- src/Silvi/Record.hs +40/−54
- src/Silvi/Types.hs +13/−33
silvi.cabal view
@@ -1,7 +1,7 @@ --------------------------------------------------------------------- name: silvi-version: 0.0.2+version: 0.0.3 build-type: Simple cabal-version: >= 1.10 category: Testing@@ -29,15 +29,16 @@ library hs-source-dirs: src- build-depends: base >= 4.9 && < 5.0+ build-depends: base >= 4.9 && < 5.0 , bytestring , chronos , http-types , ip , quantification- , savage+ , savage >= 1.0.2 && < 2.0 , text exposed-modules: Silvi+ , Silvi.LogFormat , Silvi.Random , Silvi.Record , Silvi.Types@@ -45,4 +46,3 @@ other-extensions: ----------------------------------------------------------------------
+ src/Silvi/LogFormat.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}++module Silvi.LogFormat+ (+ ) where++import Silvi.Record (Field (..), SingField (..), Value (..))+import Silvi.Types++{-+ - Palo Alto logs formats, as described in:+ - https://www.paloaltonetworks.com/documentation/61/pan-os/pan-os/reports-and-logging/syslog-field-descriptions.html+ -+-}++type TestLog = '[ FieldBracketNum+ , FieldIp+ ]++type PaloAltoTraffic = '[ ]++type PaloAltoThreat = '[]++type PaloAltoHIPMatch = '[]++type PaloAltoConfig = '[]++type PaloAltoSystem = '[]++type PaloAltoSeverity = '[]++--type PaloAltoEvent = []+
src/Silvi/Random.hs view
@@ -12,35 +12,39 @@ , randLog ) where +import Chronos (now, timeToDatetime) import Chronos.Types import Data.Exists (Exists (..), Reify (..), SingList (..)) import Data.Text (Text) import Data.Word (Word8) import Net.IPv4 (ipv4)-import Network.HTTP.Types.Method-import Network.HTTP.Types.Status-import Network.HTTP.Types.Version+import Net.Types (IPv4 (..))+import qualified Network.HTTP.Types.Method as HttpM+import qualified Network.HTTP.Types.Status as HttpS+import Network.HTTP.Types.Version (http09, http10, http11, http20)+import qualified Network.HTTP.Types.Version as HttpV import Savage-import Savage.Randy (element, enum, int, print, word8)+import Savage.Randy (element, enum, enumBounded, int,+ int8, print, word16, word8) import Savage.Range (constantBounded)-import Silvi.Record (Field (..), NcsaLog,- SingField (..), TestLog,+import Silvi.Record (Field (..), SingField (..), Value (..), rmap, rtraverse) import Silvi.Types+import System.IO.Unsafe (unsafePerformIO) import Topaz.Rec (Rec (..), fromSingList) rand :: SingField a -> Gen (Value a) rand = \case- SingHttpMethod -> fmap ValueHttpMethod randomHttpMethod- SingHttpStatus -> fmap ValueHttpStatus randomHttpStatus- SingHttpProtocol -> fmap ValueHttpProtocol randomHttpProtocol- SingHttpProtocolVersion -> fmap ValueHttpProtocolVersion randomHttpProtocolVersion- SingUrl -> fmap ValueUrl randomUrl- SingUserId -> fmap ValueUserId randomUserident- SingObjSize -> fmap ValueObjSize randomObjSize- SingIp -> fmap ValueIp randomIPv4- SingTimestamp -> fmap ValueTimestamp randomOffsetDatetime+ SingBracketNum -> ValueBracketNum <$> randomBracketNum+ SingHttpMethod -> ValueHttpMethod <$> randomHttpMethod+ SingHttpStatus -> ValueHttpStatus <$> randomHttpStatus+ SingHttpVersion -> ValueHttpVersion <$> randomHttpVersion+ SingUrl -> ValueUrl <$> randomUrl+ SingUserId -> ValueUserId <$> randomUserident+ SingObjSize -> ValueObjSize <$> randomObjSize+ SingIp -> ValueIp <$> randomIPv4+ SingTimestamp -> ValueTimestamp <$> randomOffsetDatetime randLog :: forall as. (Reify as) => Gen (Rec Value as) randLog = randLogExplicit (fromSingList (reify :: SingList as))@@ -55,28 +59,25 @@ <*> word8 constantBounded <*> word8 constantBounded -randomHttpMethod :: Gen HttpMethod-randomHttpMethod = element httpMethods+randomBracketNum :: Gen BracketNum+randomBracketNum = BracketNum <$> word8 constantBounded -randomHttpStatus :: Gen HttpStatus-randomHttpStatus = element httpStatuses+randomHttpMethod :: Gen HttpM.StdMethod+randomHttpMethod = enumBounded -randomHttpProtocol :: Gen HttpProtocol-randomHttpProtocol = element httpProtocols+randomHttpStatus :: Gen HttpS.Status+randomHttpStatus = enumBounded -randomHttpProtocolVersion :: Gen HttpProtocolVersion-randomHttpProtocolVersion = element httpProtocolVersions+randomHttpVersion :: Gen HttpV.HttpVersion+randomHttpVersion = element [http09, http10, http11, http20] -randomUserident :: Gen Text+randomUserident :: Gen UserId randomUserident = element userIdents -randomObjSize :: Gen Int-randomObjSize = int constantBounded--randomQuote :: Gen Text-randomQuote = element quotes+randomObjSize :: Gen ObjSize+randomObjSize = ObjSize <$> word16 constantBounded -randomUrl :: Gen Text+randomUrl :: Gen Url randomUrl = element urls randomDatetime :: Gen Datetime@@ -96,7 +97,38 @@ <*> (Month <$> enum 0 11) <*> (DayOfMonth <$> enum 1 31) +randomYear' :: Int -- ^ Origin year+ -> Int -- ^ End year, Usually current year+ -> Gen Year+randomYear' a b = Year <$> enum (min a b) (max a b) +-- | Random year, generated from a given year to the current one.+--+randomYear :: Int -- ^ Origin year+ -> Gen Year+randomYear a = randomYear' a b+ where b = (getYear . dateYear . datetimeDate) $ (timeToDatetime (unsafePerformIO now))++randomMonth' :: Int -- ^ Origin month+ -> Int -- ^ End month, usually current+ -> Gen Month+randomMonth' a b = Month <$> enum (min a b) (max a b)++randomMonth :: Int -- ^ Origin month+ -> Gen Month+randomMonth a = randomMonth' a b+ where b = (getMonth . dateMonth . datetimeDate) $ (timeToDatetime (unsafePerformIO now))++randomDay' :: Int -- ^ Origin Day+ -> Int -- ^ End day, usually the current day+ -> Gen DayOfMonth+randomDay' a b = DayOfMonth <$> enum (min a b) (max a b)++randomDay :: Int -- ^ Origin Day+ -> Gen DayOfMonth+randomDay a = randomDay' a b+ where b = (getDayOfMonth . dateDay . datetimeDate) $ (timeToDatetime (unsafePerformIO now))+ randomOffsetDatetime :: Gen OffsetDatetime randomOffsetDatetime = OffsetDatetime <$> randomDatetime@@ -105,35 +137,16 @@ randomOffset :: Gen Offset randomOffset = element offsets --- | List of HTTP Methods.-httpMethods :: [HttpMethod]-httpMethods = [methodGet,methodPost,methodHead,methodPut,methodDelete,methodTrace,methodConnect,methodOptions,methodPatch]---- | List of HTTP Protocols.-httpProtocols :: [HttpProtocol]-httpProtocols = [HTTP,HTTPS,FTP]---- | List of HTTP Protocol Versions.-httpProtocolVersions :: [HttpProtocolVersion]-httpProtocolVersions = [http09,http10,http11,http20]---- | List of HTTP Status Codes.-httpStatuses :: [HttpStatus]-httpStatuses = [status200,status204,status301,status400,status401,status403,status404,status405,status500,status503,status504]- -- | List of sample Useridents.-userIdents :: [Text]-userIdents = ["-","userFoo","userBar","userBaz"]+userIdents :: [UserId]+userIdents = map UserId ["-","andrewthad","cement","chessai"] -- | List of sample URLs.-urls :: [Text]-urls = ["https://github.com","http://bar.com","ftp://baz.com"]--quotes :: [Text]-quotes = ["customerA got caught putting their hand in the cookie jar","customerB uses firefox instead of chrome"]+urls :: [Url]+urls = map Url ["https://github.com","https://youtube.com","layer3com.com"] -- | List of sample -- | List of Time Zone Offsets. See: -- https://en.wikipedia.org/wiki/List_of_time_zone_abbreviations offsets :: [Offset]-offsets = map Offset [100,200,300,330,400,430,500,530,545,600,630,700,800,845,900,930,1000,1030,1100,1200,1245,1300,1345,1400,0,(-100),(-200),(-230),(-300),(-330),(-400),(-500),(-600),(-700),(-800),(-900),(-930),(-1000),(-1100),(-1200)]+offsets = map Offset [100,200,300,330,400,430,500,530,545,600,630,700,800,845,900,930,1000,1030,1100,1200,1245,1300,1345,1400,0,-100,-200,-230,-300,-330,-400,-500,-600,-700,-800,-900,-930,-1000,-1100,-1200]
src/Silvi/Record.hs view
@@ -11,29 +11,31 @@ module Silvi.Record ( rmap , rtraverse- , NcsaLog- , TestLog , Field(..) , Value(..) , SingField(..) ) where -import Chronos.Types (OffsetDatetime (..))-import Data.Exists (Exists (..), Reify (..), ShowForall (..), Sing)-import Data.Kind (Type)-import Data.Text (Text)-import GHC.Generics (Generic)-import Net.Types (IPv4)+import Chronos.Types (OffsetDatetime (..))+import Data.Exists (Exists (..), Reify (..),+ ShowForall (..), Sing)+import Data.Kind (Type)+import Data.Text (Text)+import GHC.Generics (Generic)+import Net.Types (IPv4)+import qualified Network.HTTP.Types.Method as HttpM+import qualified Network.HTTP.Types.Status as HttpS+import qualified Network.HTTP.Types.Version as HttpV import Silvi.Types-import Topaz.Rec (Rec (..), traverse)-import qualified Topaz.Rec as Topaz+import Topaz.Rec (Rec (..), traverse)+import qualified Topaz.Rec as Topaz -- | Different types present in logs. data Field- = FieldHttpMethod -- ^ More explicit name for Network.HTTP.Types.Method+ = FieldBracketNum -- ^ Number that appears before many logs, in the form of "<X>"+ | FieldHttpMethod -- ^ More explicit name for Network.HTTP.Types.Method | FieldHttpStatus -- ^ More explicit name for Network.HTTP.Types.Status- | FieldHttpProtocol -- ^ The HTTP Protocol used- | FieldHttpProtocolVersion -- ^ More explicit name for Network.HTTP.Types.Version+ | FieldHttpVersion -- ^ More explicit name for Network.HTTP.Types.Version | FieldUrl -- ^ a url, e.g. "https://hackage.haskell.org" | FieldUserId -- ^ userId as Text | FieldObjSize -- ^ usually requested resource size@@ -42,64 +44,48 @@ deriving (Bounded,Enum,Eq,Generic,Ord,Read,Show) data Value :: Field -> Type where- ValueHttpMethod :: HttpMethod -> Value 'FieldHttpMethod- ValueHttpStatus :: HttpStatus -> Value 'FieldHttpStatus- ValueHttpProtocol :: HttpProtocol -> Value 'FieldHttpProtocol- ValueHttpProtocolVersion :: HttpProtocolVersion -> Value 'FieldHttpProtocolVersion- ValueUrl :: Text -> Value 'FieldUrl- ValueUserId :: Text -> Value 'FieldUserId- ValueObjSize :: Int -> Value 'FieldObjSize- ValueIp :: IPv4 -> Value 'FieldIp- ValueTimestamp :: OffsetDatetime -> Value 'FieldTimestamp+ ValueBracketNum :: BracketNum -> Value 'FieldBracketNum+ ValueHttpMethod :: HttpM.StdMethod -> Value 'FieldHttpMethod+ ValueHttpStatus :: HttpS.Status -> Value 'FieldHttpStatus+ ValueHttpVersion :: HttpV.HttpVersion -> Value 'FieldHttpVersion+ ValueUrl :: Url -> Value 'FieldUrl+ ValueUserId :: UserId -> Value 'FieldUserId+ ValueObjSize :: ObjSize -> Value 'FieldObjSize+ ValueIp :: IPv4 -> Value 'FieldIp+ ValueTimestamp :: OffsetDatetime -> Value 'FieldTimestamp instance ShowForall Value where- showsPrecForall p (ValueHttpMethod x) = showParen (p > 10) $ showString "ValueHttpMethod" . showsPrec 11 x- showsPrecForall p (ValueHttpStatus x) = showParen (p > 10) $ showString "ValueHttpStatus" . showsPrec 11 x- showsPrecForall p (ValueHttpProtocol x) = showParen (p > 10) $ showString "ValueHttpProtocol" . showsPrec 11 x- showsPrecForall p (ValueHttpProtocolVersion x) = showParen (p > 10) $ showString "ValueHttpProtocolVersion" . showsPrec 11 x- showsPrecForall p (ValueUrl x) = showParen (p > 10) $ showString "ValueUrl" . showsPrec 11 x- showsPrecForall p (ValueUserId x) = showParen (p > 10) $ showString "ValueUserId" . showsPrec 11 x- showsPrecForall p (ValueObjSize x) = showParen (p > 10) $ showString "ValueObjSize" . showsPrec 11 x- showsPrecForall p (ValueIp x) = showParen (p > 10) $ showString "ValueIp" . showsPrec 11 x- showsPrecForall p (ValueTimestamp x) = showParen (p > 10) $ showString "ValueTimestamp" . showsPrec 11 x+ showsPrecForall p (ValueBracketNum x) = showParen (p > 10) $ showString "ValueBracketNum" . showsPrec 11 x+ showsPrecForall p (ValueHttpMethod x) = showParen (p > 10) $ showString "ValueHttpMethod" . showsPrec 11 x+ showsPrecForall p (ValueHttpStatus x) = showParen (p > 10) $ showString "ValueHttpStatus" . showsPrec 11 x+ showsPrecForall p (ValueHttpVersion x) = showParen (p > 10) $ showString "ValueHttpVersion" . showsPrec 11 x+ showsPrecForall p (ValueUrl x) = showParen (p > 10) $ showString "ValueUrl" . showsPrec 11 x+ showsPrecForall p (ValueUserId x) = showParen (p > 10) $ showString "ValueUserId" . showsPrec 11 x+ showsPrecForall p (ValueObjSize x) = showParen (p > 10) $ showString "ValueObjSize" . showsPrec 11 x+ showsPrecForall p (ValueIp x) = showParen (p > 10) $ showString "ValueIp" . showsPrec 11 x+ showsPrecForall p (ValueTimestamp x) = showParen (p > 10) $ showString "ValueTimestamp" . showsPrec 11 x data SingField :: Field -> Type where+ SingBracketNum :: SingField 'FieldBracketNum SingHttpMethod :: SingField 'FieldHttpMethod SingHttpStatus :: SingField 'FieldHttpStatus- SingHttpProtocol :: SingField 'FieldHttpProtocol- SingHttpProtocolVersion :: SingField 'FieldHttpProtocolVersion+ SingHttpVersion :: SingField 'FieldHttpVersion SingUrl :: SingField 'FieldUrl SingUserId :: SingField 'FieldUserId SingObjSize :: SingField 'FieldObjSize SingIp :: SingField 'FieldIp SingTimestamp :: SingField 'FieldTimestamp --type TestLog = '[ FieldIp- , FieldTimestamp- ]--- | A single log entry from NCSA Common or Extended-formatted log. See:--- http://publib.boulder.ibm.com/tividd/td/ITWSA/ITWSA_info45/en_US/HTML/guide/c-logs.html#combined-type NcsaLog = '[ FieldIp- , FieldUserId- , FieldTimestamp- , FieldHttpMethod- , FieldUrl- , FieldHttpProtocol- , FieldHttpProtocolVersion- , FieldHttpStatus- , FieldObjSize- ]- type instance Sing = SingField++instance Reify 'FieldBracketNum where+ reify = SingBracketNum instance Reify 'FieldHttpMethod where reify = SingHttpMethod instance Reify 'FieldHttpStatus where reify = SingHttpStatus-instance Reify 'FieldHttpProtocol where- reify = SingHttpProtocol-instance Reify 'FieldHttpProtocolVersion where- reify = SingHttpProtocolVersion+instance Reify 'FieldHttpVersion where+ reify = SingHttpVersion instance Reify 'FieldUrl where reify = SingUrl instance Reify 'FieldUserId where
src/Silvi/Types.hs view
@@ -1,40 +1,12 @@ module Silvi.Types- ( HttpMethod(..)- , HttpStatus(..)- , HttpProtocol(..)- , HttpProtocolVersion(..)- , Url(..)+ ( Url(..) , UserId(..) , ObjSize(..)- , IPv4(..)- , OffsetDatetime(..)+ , BracketNum(..) ) where -import Chronos.Types (Offset (..), OffsetDatetime (..))-import Data.Text (Text)-import Net.Types (IPv4 (..))-import Network.HTTP.Types.Method-import Network.HTTP.Types.Status-import Network.HTTP.Types.Version---- | Type alias for Netowrk.HTTP.Types.Method, renamed--- to be more explicit.----type HttpMethod = Method---- | Type alias for Network.HTTP.Types.Status, renamed--- to be more explicit.----type HttpStatus = Status---- | The HTTP Protocol used.----data HttpProtocol = HTTP | HTTPS | FTP deriving (Show, Eq)---- | Type alias for Network.HTTP.Types.Version, renamed--- to be more explicit.----type HttpProtocolVersion = HttpVersion+import Data.Text (Text)+import Data.Word (Word16, Word8) -- | Url type. -- TODO: Expand on this for better randomisation.@@ -49,5 +21,13 @@ -- | Requested resource size. ---newtype ObjSize = ObjSize { getObjSize :: Text }+newtype ObjSize = ObjSize { getObjSize :: Word16 } deriving (Show,Eq)++-- | Angle-bracketed number that appears before many logs.+--+newtype BracketNum = BracketNum { getBracketNum :: Word8 }+ deriving (Eq)++instance Show BracketNum where+ show (BracketNum x) = "<" ++ show x ++ ">"