{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}

-- | This is an arguably convenient wrapper around gogol's `Network.Google.FireStore`. This is likely not the idiomatic or best API for Google Firestore\/Datastore\/Firebase. I don't even understand the difference between all of those trademarks. Bug reports and suggestions are welcome.
module Database.Firestore
  ( -- * The types
    Document (..),
    Value (..),
    FireStore,

    -- * Running `FireStore`
    runFireStore,
    defaultEnvironment,

    -- * CRUD
    listAllDocuments,
    patchDocument,

    -- * Other stuff

    -- | You can check out the docs for the additional types, as well as the lenses in the `Database.Firestore.Types` module:
    module Database.Firestore.Types,
  )
where

import Control.Lens ((&), (.~), (<&>), (^.))
import Control.Monad.Trans.Resource
-- import Data.Aeson
import Data.Data
import qualified Data.Text as Text
import Database.Firestore.Internal
import Database.Firestore.Types
import Network.Google (AllowScopes, HasEnv)
import qualified Network.Google as Google
import qualified Network.Google.Auth.Scope as Google
import qualified Network.Google.FireStore as FireStore
import System.IO (stderr)

-- | This initializes the the google environment with stderr logging, tls manager, and "application default" credentials. (@gcloud auth login@ on your local machine, or maybe @gcloud auth application-default login@, and it will also probably "just work" with the relevant service account (e.g. "compute") in the cloud). It will only have the scopes needed for FireStore (`FireStoreScope`).
--
-- This is just pure convenience.
--
-- > do
-- >   env <- defaultEnvironment
-- >   result <- runFireStore env "myproject" someFireStoreAction
defaultEnvironment :: IO (Google.Env FireStoreScope)
defaultEnvironment :: IO (Env FireStoreScope)
defaultEnvironment = do
  Logger
lgr <- LogLevel -> Handle -> IO Logger
forall (m :: * -> *). MonadIO m => LogLevel -> Handle -> m Logger
Google.newLogger LogLevel
Google.Trace Handle
stderr
  Manager
mgr <- ManagerSettings -> IO Manager
Google.newManager ManagerSettings
Google.tlsManagerSettings
  Credentials FireStoreScope
crd <- Manager -> IO (Credentials FireStoreScope)
forall (m :: * -> *) (s :: [Symbol]).
(MonadIO m, MonadCatch m) =>
Manager -> m (Credentials s)
Google.getApplicationDefault Manager
mgr
  Credentials FireStoreScope
-> Logger -> Manager -> IO (Env FireStoreScope)
forall (m :: * -> *) (s :: [Symbol]).
(MonadIO m, MonadCatch m, AllowScopes s) =>
Credentials s -> Logger -> Manager -> m (Env s)
Google.newEnvWith Credentials FireStoreScope
crd Logger
lgr Manager
mgr IO (Env FireStoreScope)
-> (Env FireStoreScope -> Env FireStoreScope)
-> IO (Env FireStoreScope)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Proxy FireStoreScope -> Identity (Proxy FireStoreScope))
-> Env FireStoreScope -> Identity (Env FireStoreScope)
forall (s :: [Symbol]) a. HasEnv s a => Lens' a (Proxy s)
Google.envScopes ((Proxy FireStoreScope -> Identity (Proxy FireStoreScope))
 -> Env FireStoreScope -> Identity (Env FireStoreScope))
-> Proxy FireStoreScope -> Env FireStoreScope -> Env FireStoreScope
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proxy FireStoreScope
forall k (t :: k). Proxy t
Proxy @FireStoreScope)

-- | Runs the FireStore monad. It needs the env and the project name.
--
-- > runFireStore env "myproject" someFireStoreAction
runFireStore ::
  ( MonadUnliftIO m,
    HasEnv s env,
    AllowScopes s,
    Google.HasScope' s FireStoreScope ~ 'True
  ) =>
  env ->
  Text.Text ->
  FireStore a ->
  m a
runFireStore :: env -> Text -> FireStore a -> m a
runFireStore env
env Text
project (FireStore Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
_action) = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT m a -> m a) -> ResourceT m a -> m a
forall a b. (a -> b) -> a -> b
$ env -> Google s a -> ResourceT m a
forall (m :: * -> *) (s :: [Symbol]) r a.
(MonadResource m, HasEnv s r) =>
r -> Google s a -> m a
Google.runGoogle env
env (Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
_action Text
project)

listDocumentsOnePage :: Text.Text -> Maybe PageToken -> FireStore ([Document], Maybe PageToken)
listDocumentsOnePage :: Text -> Maybe PageToken -> FireStore ([Document], Maybe PageToken)
listDocumentsOnePage Text
collectionName Maybe PageToken
np =
  do
    ListDocumentsResponse
res <- (Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m ListDocumentsResponse)
-> FireStore ListDocumentsResponse
forall a.
(Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
FireStore ((Text
  -> forall (m :: * -> *) (s :: [Symbol]).
     (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
     m ListDocumentsResponse)
 -> FireStore ListDocumentsResponse)
-> (Text
    -> forall (m :: * -> *) (s :: [Symbol]).
       (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
       m ListDocumentsResponse)
-> FireStore ListDocumentsResponse
forall a b. (a -> b) -> a -> b
$
      \Text
projectName ->
        Text -> Text -> ProjectsDatabasesDocumentsList
FireStore.projectsDatabasesDocumentsList
          (Text
"projects/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/databases/(default)/documents/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
collectionName)
          Text
""
          ProjectsDatabasesDocumentsList
-> (ProjectsDatabasesDocumentsList
    -> ProjectsDatabasesDocumentsList)
-> ProjectsDatabasesDocumentsList
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> ProjectsDatabasesDocumentsList
-> Identity ProjectsDatabasesDocumentsList
Lens' ProjectsDatabasesDocumentsList (Maybe Text)
FireStore.pPageToken ((Maybe Text -> Identity (Maybe Text))
 -> ProjectsDatabasesDocumentsList
 -> Identity ProjectsDatabasesDocumentsList)
-> Maybe Text
-> ProjectsDatabasesDocumentsList
-> ProjectsDatabasesDocumentsList
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PageToken -> Text) -> Maybe PageToken -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PageToken -> Text
_unPageToken Maybe PageToken
np
          ProjectsDatabasesDocumentsList
-> (ProjectsDatabasesDocumentsList -> m ListDocumentsResponse)
-> m ListDocumentsResponse
forall a b. a -> (a -> b) -> b
& ProjectsDatabasesDocumentsList -> m ListDocumentsResponse
forall (s :: [Symbol]) (m :: * -> *) a.
(MonadGoogle s m, HasScope s a, GoogleRequest a) =>
a -> m (Rs a)
Google.send
    ([Document], Maybe PageToken)
-> FireStore ([Document], Maybe PageToken)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Document -> Document) -> [Document] -> [Document]
forall a b. (a -> b) -> [a] -> [b]
map Document -> Document
parseDocument ([Document] -> [Document]) -> [Document] -> [Document]
forall a b. (a -> b) -> a -> b
$ ListDocumentsResponse
res ListDocumentsResponse
-> Getting [Document] ListDocumentsResponse [Document]
-> [Document]
forall s a. s -> Getting a s a -> a
^. Getting [Document] ListDocumentsResponse [Document]
Lens' ListDocumentsResponse [Document]
FireStore.ldrDocuments, Text -> PageToken
PageToken (Text -> PageToken) -> Maybe Text -> Maybe PageToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListDocumentsResponse
res ListDocumentsResponse
-> Getting (Maybe Text) ListDocumentsResponse (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ListDocumentsResponse (Maybe Text)
Lens' ListDocumentsResponse (Maybe Text)
FireStore.ldrNextPageToken)

-- | It only wants the collection name itself. In the language of the Google's resource identifiers,
-- this will get into @("projects\/" <> projectName <> "\/databases\/(default)\/documents\/" <> collectionName)@.
-- Apparently, @(default)@ is the actual real name of the only database you can have.
listAllDocuments :: Text.Text -> FireStore [Document]
listAllDocuments :: Text -> FireStore [Document]
listAllDocuments Text
collectionName = Maybe PageToken -> FireStore [Document]
getPage Maybe PageToken
forall a. Maybe a
Nothing
  where
    getPage :: Maybe PageToken -> FireStore [Document]
getPage Maybe PageToken
pt =
      do
        ([Document]
res, Maybe PageToken
np) <- Text -> Maybe PageToken -> FireStore ([Document], Maybe PageToken)
listDocumentsOnePage Text
collectionName Maybe PageToken
pt
        case Maybe PageToken
np of
          Maybe PageToken
Nothing -> [Document] -> FireStore [Document]
forall (m :: * -> *) a. Monad m => a -> m a
return [Document]
res
          Just PageToken
pt' -> ([Document]
res [Document] -> [Document] -> [Document]
forall a. [a] -> [a] -> [a]
++) ([Document] -> [Document])
-> FireStore [Document] -> FireStore [Document]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PageToken -> FireStore [Document]
getPage (PageToken -> Maybe PageToken
forall a. a -> Maybe a
Just PageToken
pt')

patchDocument :: Text.Text -> Document -> FireStore Document
-- patchDocument (Document {name = Nothing}) = error "Can't patch a"
patchDocument :: Text -> Document -> FireStore Document
patchDocument Text
path Document
document =
  do
    Document
res <- (Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m Document)
-> FireStore Document
forall a.
(Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
FireStore ((Text
  -> forall (m :: * -> *) (s :: [Symbol]).
     (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
     m Document)
 -> FireStore Document)
-> (Text
    -> forall (m :: * -> *) (s :: [Symbol]).
       (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
       m Document)
-> FireStore Document
forall a b. (a -> b) -> a -> b
$
      \Text
projectName ->
        Document -> Text -> ProjectsDatabasesDocumentsPatch
FireStore.projectsDatabasesDocumentsPatch
          (Document -> Document
buildDocument Document
document)
          (Text
"projects/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/databases/(default)/documents/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
          ProjectsDatabasesDocumentsPatch
-> (ProjectsDatabasesDocumentsPatch -> m Document) -> m Document
forall a b. a -> (a -> b) -> b
& ProjectsDatabasesDocumentsPatch -> m Document
forall (s :: [Symbol]) (m :: * -> *) a.
(MonadGoogle s m, HasScope s a, GoogleRequest a) =>
a -> m (Rs a)
Google.send

    Document -> FireStore Document
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> FireStore Document) -> Document -> FireStore Document
forall a b. (a -> b) -> a -> b
$ Document -> Document
parseDocument Document
res