Random.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Silvi.Random
  ( rand
  , randLogExplicit
  , randLog
  ) where

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           Savage
import           Savage.Randy               (element, enum, int, print, word8)
import           Savage.Range               (constantBounded)
import           Silvi.Record               (Field (..), NcsaLog,
                                             SingField (..), TestLog,
                                             Value (..), rmap, rtraverse)
import           Silvi.Types
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

randLog :: forall as. (Reify as) => Gen (Rec Value as)
randLog = randLogExplicit (fromSingList (reify :: SingList as))

randLogExplicit :: Rec SingField rs -> Gen (Rec Value rs)
randLogExplicit = rtraverse rand

randomIPv4 :: Gen IPv4
randomIPv4 = ipv4
  <$> word8 constantBounded
  <*> word8 constantBounded
  <*> word8 constantBounded
  <*> word8 constantBounded

randomHttpMethod :: Gen HttpMethod
randomHttpMethod = element httpMethods

randomHttpStatus :: Gen HttpStatus
randomHttpStatus = element httpStatuses

randomHttpProtocol :: Gen HttpProtocol
randomHttpProtocol = element httpProtocols

randomHttpProtocolVersion :: Gen HttpProtocolVersion
randomHttpProtocolVersion = element httpProtocolVersions

randomUserident :: Gen Text
randomUserident = element userIdents

randomObjSize :: Gen Int
randomObjSize = int constantBounded

randomQuote :: Gen Text
randomQuote = element quotes

randomUrl :: Gen Text
randomUrl = element urls

randomDatetime :: Gen Datetime
randomDatetime = Datetime
  <$> randomDate
  <*> randomTimeOfDay

randomTimeOfDay :: Gen TimeOfDay
randomTimeOfDay = TimeOfDay
  <$> enum 0    24
  <*> enum 0    59
  <*> enum 0 59999

randomDate :: Gen Date
randomDate = Date
  <$> (Year       <$> enum 1995 2100)
  <*> (Month      <$> enum    0   11)
  <*> (DayOfMonth <$> enum    1   31)


randomOffsetDatetime :: Gen OffsetDatetime
randomOffsetDatetime = OffsetDatetime
  <$> randomDatetime
  <*> randomOffset

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"]

-- | 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"]

-- | 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)]