content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  module Glean.RTS.Foreign.Inventory
    ( Inventory
    , CompiledPredicate(..)
    , new
    , predicates
    , serialize
    , deserialize
    , Validate(..)
    , validate
    ) where
  
  import Control.Monad
  import Data.ByteString (ByteString)
  import Data.Default
  import Data.List (unzip6)
  import Foreign hiding (with, withMany, new)
  import Foreign.C
  import System.IO.Unsafe (unsafePerformIO)
  
  import Util.FFI
  
  import Glean.FFI
  import Glean.RTS.Typecheck
  import Glean.RTS.Traverse
  import Glean.RTS.Foreign.Bytecode (Subroutine)
  import Glean.RTS.Foreign.Lookup (Lookup(..), CanLookup(..))
  import Glean.RTS.Types (Pid(..))
  import Glean.Types (PredicateRef(..))
  
  -- | Information about predicates in an open DB
  newtype Inventory = Inventory (ForeignPtr Inventory)
  
  instance Object Inventory where
    wrap = Inventory
    unwrap (Inventory p) = p
    destroy = glean_inventory_free
  
  -- | A compiled predicate definition
  data CompiledPredicate = CompiledPredicate
    { compiledPid :: Pid
    , compiledRef :: PredicateRef
    , compiledTypecheck :: Subroutine CompiledTypecheck
    , compiledTraversal :: Subroutine CompiledTraversal
    }
  
  -- | Create a new 'Inventory' from a list of predicate specs. Predicates will be
  -- assigned consecutive ids starting with first. Each predicate is accompanied
  -- by a bytecode subrouting for fact typechecking (from
  -- 'Glean.RTS.Typecheck.checkSignature').
  new :: [CompiledPredicate] -> Inventory
  -- NOTE: This is pure because inventories are immutable.
  new ps = unsafePerformIO $ withMany predicate ps $ \qs ->
    let (ids,
         name_ptrs,
         name_sizes,
         versions,
         tcs,
         trs) = unzip6 qs
    in
    withArray ids $ \p_ids ->
    withArray name_ptrs $ \p_name_ptrs ->
    withArray name_sizes $ \p_name_sizes ->
    withArray versions $ \p_versions ->
    withArray tcs $ \p_tcs ->
    withArray trs $ \p_trs ->
    construct $ invoke $ glean_inventory_new
      (fromIntegral n)
      p_ids
      p_name_ptrs
      p_name_sizes
      p_versions
      p_tcs
      p_trs
    where
      !n = length ps
      predicate CompiledPredicate{..} f =
        withUTF8Text (predicateRef_name compiledRef) $ \name_ptr name_size ->
        with compiledTypecheck $ \tc_ptr ->
        with compiledTraversal $ \tr_ptr ->
        f ( compiledPid
          , name_ptr
          , name_size
          , fromIntegral $ predicateRef_version compiledRef
          , tc_ptr
          , tr_ptr )
  
  instance Eq Inventory where
    a == b = unsafePerformIO $
      with a $ \a_ptr ->
      with b $ \b_ptr -> do
        r <- invoke $ glean_inventory_equal a_ptr b_ptr
        return $ r /= 0
  
  newtype PredicatePtr = PredicatePtr (Ptr PredicatePtr)
    deriving(Storable)
  
  -- | Return all predicates from an 'Inventory'
  predicates :: Inventory -> IO [(Pid, PredicateRef)]
  predicates inventory = with inventory $ \inventory_ptr -> do
    (count, preds) <- invoke $ glean_inventory_predicates inventory_ptr
    usingMalloced preds $ forM [1 .. count] $ \i -> do
      p <- peekElemOff preds $ fromIntegral i - 1
      (pid, name_ptr, name_size, version) <- invoke $ glean_predicate_unpack p
      ref <- PredicateRef
        <$> fromUTF8 name_ptr name_size
        <*> pure (fromIntegral version)
      return (pid, ref)
  
  serialize :: Inventory -> ByteString
  serialize inventory = unsafePerformIO $
    with inventory $ \inventory_ptr -> do
      (bytes, size) <- invoke $ glean_inventory_serialize inventory_ptr
      unsafeMallocedByteString bytes size
  
  deserialize :: ByteString -> Inventory
  deserialize s = unsafePerformIO $
    unsafeWithBytes s $ \p n ->
    construct $ invoke $ glean_inventory_deserialize p n
  
  data Validate = Validate
    { validateTypecheck :: Bool
    , validateKeys :: Bool
    , validateLimit :: Maybe Int
    }
  
  instance Default Validate where
    def = Validate
      { validateTypecheck = True
      , validateKeys = True
      , validateLimit = Nothing
      }
  
  validate :: CanLookup a => Inventory -> Validate -> a -> IO ()
  validate inventory Validate{..} lookupable =
    with inventory $ \inventory_ptr ->
    withLookup lookupable $ \lookup ->
    invoke $ glean_validate
      inventory_ptr
      (if validateTypecheck then 1 else 0)
      (if validateKeys then 1 else 0)
      (maybe maxBound fromIntegral validateLimit)
      lookup
  
  foreign import ccall unsafe glean_inventory_new
    :: CSize
    -> Ptr Pid
    -> Ptr (Ptr ())
    -> Ptr CSize
    -> Ptr Int32
    -> Ptr (Ptr (Subroutine CompiledTypecheck))
    -> Ptr (Ptr (Subroutine CompiledTraversal))
    -> Ptr (Ptr Inventory)
    -> IO CString
  foreign import ccall unsafe "&glean_inventory_free" glean_inventory_free
    :: Destroy Inventory
  
  foreign import ccall unsafe glean_inventory_predicates
    :: Ptr Inventory
    -> Ptr CSize
    -> Ptr (Ptr PredicatePtr)
    -> IO CString
  
  foreign import ccall unsafe glean_inventory_serialize
    :: Ptr Inventory
    -> Ptr (Ptr ())
    -> Ptr CSize
    -> IO CString
  
  foreign import ccall unsafe glean_inventory_deserialize
    :: Ptr ()
    -> CSize
    -> Ptr (Ptr Inventory)
    -> IO CString
  
  foreign import ccall unsafe glean_inventory_equal
    :: Ptr Inventory
    -> Ptr Inventory
    -> Ptr CBool
    -> IO CString
  
  foreign import ccall unsafe glean_predicate_unpack
    :: PredicatePtr
    -> Ptr Pid
    -> Ptr (Ptr ())
    -> Ptr CSize
    -> Ptr Int32
    -> IO CString
  
  foreign import ccall safe glean_validate
    :: Ptr Inventory
    -> CChar
    -> CChar
    -> CSize
    -> Ptr Lookup
    -> IO CString
  