{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
module Arbor.Albedo.Scan.Metadata
where
import Antiope.Core (toText, runAwsTyped)
import Antiope.Env (Env)
import Antiope.S3 (S3Uri)
import Antiope.S3.Strict (downloadFromS3Uri)
import Control.Applicative ((<|>))
import Control.Lens (from, (&), (<&>), (^.))
import Control.Monad.Reader (MonadReader)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Aeson
import Data.Aeson.Types
import Data.ByteString.Lazy (fromStrict)
import Data.Generics.Product.Any (the)
import Data.Generics.Product.Typed (HasType)
import Data.Int (Int64)
import Data.Maybe
import Data.Thyme.Time.Core (UTCTime, microseconds, posixSecondsToUTCTime, toSeconds, utcTimeToPOSIXSeconds)
import GHC.Generics hiding (from)
import HaskellWorks.Data.Aeson
import HaskellWorks.Data.Network.Ip.Ipv4 (IpBlock)
import HaskellWorks.Data.Network.Ip.Validity (Canonical)
import qualified Data.Text as Text
newtype Proto = Proto { unProto :: Int } deriving (Generic, Show, Eq, FromJSON, ToJSON)
data Command = Command
{ name :: Maybe String
, scanner :: Maybe String
, probe :: Maybe String
, probeBanner :: Maybe String
, probeArgs :: Maybe String
, port :: Int
, proto :: Proto
, destination :: Either FilePath S3Uri
, cidr :: IpBlock Canonical
, deadline :: UTCTime
, banners :: Bool
} deriving (Generic, Show, Eq)
data ScanMetaData = ScanMetaData
{ startAt :: UTCTime
, stopAt :: UTCTime
, provenance :: Maybe String
, scanCmd :: Command
, digest :: String
, port :: Int
, proto :: Proto
, cidr :: IpBlock Canonical
, source :: Maybe String
, data' :: String
} deriving (Generic, Show, Eq)
instance FromJSON Command where
parseJSON = withObject "object" $ \o ->
Command <$> o .:? "name"
<*> o .: "scanner"
<*> o .: "probe"
<*> o .:? "probeBanner"
<*> o .:? "probeArgs"
<*> o .: "port"
<*> (o .: "proto")
<*> (o .: "destination" >>= readDestination)
<*> (o .: "cidr" >>= readJson "cidr")
<*> (o .: "deadline" & fmap int64ToUTCTime)
<*> (o .:? "banners" .!= False)
instance ToJSON Command where
toJSON r = objectWithoutNulls
[ "name" .= (r ^. the @"name")
, "scanner" .= (r ^. the @"scanner")
, "probe" .= (r ^. the @"probe")
, "probeBanner" .= (r ^. the @"probeBanner")
, "probeArgs" .= (r ^. the @"probeArgs")
, "port" .= (r ^. the @"port")
, "proto" .= (r ^. the @"proto")
, "destination" .= either Text.pack toText (r ^. the @"destination")
, "cidr" .= show (r ^. the @"cidr")
, "deadline" .= utcTimeToInt64 (r ^. the @"deadline")
, "banners" .= (r ^. the @"banners")
]
instance FromJSON ScanMetaData where
parseJSON = withObject "object" $ \o ->
ScanMetaData <$> (o .: "startAt" & fmap int64ToUTCTime)
<*> (o .: "stopAt" & fmap int64ToUTCTime)
<*> (o .:? "provenance")
<*> o .: "scanCmd"
<*> o .: "digest"
<*> o .: "port"
<*> (o .: "proto")
<*> (o .: "cidr" >>= readJson "cidr")
<*> (o .:? "source")
<*> (o .: "data")
instance ToJSON ScanMetaData where
toJSON r = objectWithoutNulls
[ "startAt" .= utcTimeToInt64 (r ^. the @"startAt")
, "stopAt" .= utcTimeToInt64 (r ^. the @"stopAt")
, "provenance" .= (r ^. the @"provenance")
, "scanCmd" .= (r ^. the @"scanCmd")
, "digest" .= (r ^. the @"digest")
, "port" .= (r ^. the @"port")
, "proto" .= (r ^. the @"proto")
, "cidr" .= show (r ^. the @"cidr")
, "source" .= (r ^. the @"source")
, "data" .= (r ^. the @"data'")
]
readDestination :: String -> Parser (Either FilePath S3Uri)
readDestination s = (Right <$> readJson "destination (s3uri)" s)
<|> (Left <$> readJson "destination (filepath)" s)
int64ToUTCTime :: Int64 -> UTCTime
int64ToUTCTime a = posixSecondsToUTCTime $ (a * 1000 * 1000) ^. from microseconds
utcTimeToInt64 :: UTCTime -> Int64
utcTimeToInt64 ut = round (toSeconds (utcTimeToPOSIXSeconds ut) :: Double)
loadScanMetadata :: (MonadUnliftIO m, MonadReader r m, HasType Env r)
=> S3Uri
-> m (Maybe ScanMetaData)
loadScanMetadata uri = runAwsTyped $ do
mb <- downloadFromS3Uri uri
pure $ mb >>= (decode . fromStrict)