Add support for realtime (#7)

spago.dhall

@@ -6,6 +6,7 @@
   , "datetime"
   , "effect"
   , "either"
+  , "exceptions"
   , "fetch"
   , "fetch-core"
   , "foldable-traversable"
@@ -21,6 +22,9 @@
   , "transformers"
   , "tuples"
   , "typelevel-prelude"
+  , "unsafe-coerce"
+  , "unsafe-reference"
+  , "untagged-union"
   , "web-file"
   , "yoga-json"
   ]

src/Supabase/AuthHelpers.js

@@ -1,8 +1,9 @@
+'use client'
 import { useUser } from "@supabase/auth-helpers-react";
+import { createBrowserSupabaseClient } from "@supabase/auth-helpers-nextjs";
 
 export const useUserImpl = useUser;
 
-import { createBrowserSupabaseClient } from "@supabase/auth-helpers-nextjs";
 
 export const createBrowserClient = () => createBrowserSupabaseClient();
 

src/Supabase/AuthHelpers.purs

@@ -20,6 +20,7 @@ import Record.Studio (mapRecordKind)
 import Supabase.Supabase as Supabase
 import Supabase.Types (Client)
 import Yoga.JSON as YogaJSON
+import Yoga.JSON (class WriteForeign)
 
 foreign import useUserImpl :: Effect { user :: Nullable Supabase.User }
 
@@ -43,14 +44,15 @@ type Options =
   { db :: Maybe String
   }
 
-type ClientOptions =
+type ClientOptions r =
   { cookieOptions :: Maybe CookieOptions
   , options :: Maybe Options
   , supabaseKey :: Maybe String
   , supabaseUrl :: Maybe String
+  | r
   }
 
 foreign import createBrowserClientWithOptionsInternal :: Foreign -> Effect Client
 
-createBrowserClientWithOptions ∷ ClientOptions → Effect Client
+createBrowserClientWithOptions ∷ forall r. WriteForeign (ClientOptions r) => ClientOptions r → Effect Client
 createBrowserClientWithOptions = YogaJSON.write >>> createBrowserClientWithOptionsInternal

src/Supabase/Realtime.js

@@ -0,0 +1,5 @@
+export const sendImpl = (what, channel) => channel.send(what)
+
+export const onImpl = (listenType, filter, callback, channel) => channel.on(listenType, filter, callback)
+
+export const subscribeImpl = (callback,timeout, channel) => channel.subscribe(callback,timeout)

src/Supabase/Realtime.purs

@@ -0,0 +1,59 @@
+module Supabase.Realtime where
+
+import Prelude
+import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, mkEffectFn1, mkEffectFn2, runEffectFn2, runEffectFn3, runEffectFn4)
+import Supabase.Types (Channel)
+import Control.Promise (Promise, toAffE)
+import Effect.Aff (Aff)
+import Effect (Effect)
+import Unsafe.Coerce (unsafeCoerce)
+import Supabase.Realtime.ListenType (RealtimeListenType)
+import Supabase.Realtime.SubscribeStates (RealtimeSubscribeState, RealtimeSubscribeState(ChannelError))
+import Effect.Exception (Error, error)
+import Untagged.Union (UndefinedOr, uorToMaybe)
+import Data.Time.Duration (Milliseconds)
+import Data.Maybe (Maybe, Maybe(Nothing), Maybe(Just))
+import Supabase.Realtime.SubscribeStates (fromString) as SubscribeState
+import Control.Monad.Error.Class (throwError)
+
+data RealtimeResponse = SendingOK | SendingTimedOut | SendingRateLimited
+
+foreign import sendImpl :: forall i. EffectFn2 { | i } Channel (Promise String)
+
+send :: forall i. { | i } -> Channel -> Aff RealtimeResponse
+send input channel = do
+  res <- runEffectFn2 sendImpl input channel # toAffE
+  case res of
+    "ok" -> pure SendingOK
+    "timed out" -> pure SendingTimedOut
+    "rate limited" -> pure SendingRateLimited
+    _ -> throwError $ error $ "Supabase.Realtime.send: invalid response: " <> res
+
+foreign import onImpl :: forall f cbi. EffectFn4 RealtimeListenType f (EffectFn1 cbi Unit) Channel Unit
+
+on :: forall f cbi. RealtimeListenType -> f -> (cbi -> Effect Unit) -> Channel -> Effect Unit
+on lt filter callback channel = runEffectFn4 onImpl lt filter (mkEffectFn1 callback) channel
+
+foreign import subscribeImpl
+  :: EffectFn3
+       (EffectFn2 String (UndefinedOr Error) Unit)
+       Milliseconds
+       Channel
+       Unit
+
+subscribe
+  :: Milliseconds
+  -> (RealtimeSubscribeState -> Maybe Error -> Effect Unit)
+  -> Channel
+  -> Effect Unit
+subscribe timeout cb channel =
+  runEffectFn3 subscribeImpl
+    ( mkEffectFn2 \st err ->
+        case SubscribeState.fromString st of
+          Nothing ->
+            cb ChannelError (Just (error $ "Supabase.Realtime.subscribe: invalid subscribe state: " <> st))
+          Just ok ->
+            cb ok (uorToMaybe err)
+    )
+    timeout
+    channel

src/Supabase/Realtime/ListenType.purs

@@ -0,0 +1,18 @@
+module Supabase.Realtime.ListenType where
+
+import Prelude
+import Unsafe.Coerce (unsafeCoerce)
+import Unsafe.Reference (unsafeRefEq)
+
+foreign import data RealtimeListenType :: Type
+instance Eq RealtimeListenType where
+  eq = unsafeRefEq
+
+broadcast :: RealtimeListenType
+broadcast = unsafeCoerce "broadcast"
+
+presence :: RealtimeListenType
+presence = unsafeCoerce "presence"
+
+postgresChanges :: RealtimeListenType
+postgresChanges = unsafeCoerce "postgres_changes"

src/Supabase/Realtime/SubscribeStates.purs

@@ -0,0 +1,25 @@
+module Supabase.Realtime.SubscribeStates where
+
+import Prelude
+import Unsafe.Coerce (unsafeCoerce)
+import Unsafe.Reference (unsafeRefEq)
+import Data.Maybe (Maybe(Nothing), Maybe, Maybe(Just))
+
+data RealtimeSubscribeState = Subscribed | TimedOut | Closed | ChannelError
+derive instance Eq RealtimeSubscribeState
+
+toString :: RealtimeSubscribeState -> String
+toString = case _ of
+  Subscribed -> "SUBSCRIBED"
+  TimedOut -> "TIMED_OUT"
+  Closed -> "CLOSED"
+  ChannelError -> "CHANNEL_ERROR"
+
+fromString :: String -> Maybe RealtimeSubscribeState
+fromString = case _ of
+  "SUBSCRIBED" -> Just Subscribed
+  "TIMED_OUT" -> Just TimedOut
+  "CLOSED" -> Just Closed
+  "CHANNEL_ERROR" -> Just ChannelError
+  _ -> Nothing
+

src/Supabase/Supabase.js

@@ -8,6 +8,8 @@ export const getSessionImpl = (supabase) => () => supabase.auth.getSession();
 export const onAuthStateChangeImpl = (supabase) => (handler) => () =>
   supabase.auth.onAuthStateChange((_event, session) => handler(session));
 
+export const getUserImpl = supabase => () => supabase.auth.getUser();
+
 export const signOutImpl = (supabase) => () => supabase.auth.signOut();
 export const fromImpl = (client) => (table) => client.from(table);
 export const selectQueryImpl = (queryBuilder) => (projection) =>
@@ -45,3 +47,5 @@ export const invokeImpl = (client) => (functionName, body, headers) => () =>
     body,
     headers,
   });
+
+export const channel = (channelName) => (client) => () => client.channel(channelName);

src/Supabase/Supabase.purs

@@ -19,6 +19,7 @@ module Supabase.Supabase
   , class Select
   , delete
   , equals
+  , channel
   , from
   , getSession
   , invoke
@@ -26,6 +27,7 @@ module Supabase.Supabase
   , onAuthStateChange
   , range
   , select
+  , getUser
   , signInWithOtp
   , signInWithOtpOptions
   , signOut
@@ -37,26 +39,28 @@ module Supabase.Supabase
 import Prelude
 
 import Control.Promise (Promise)
-import Control.Promise as Promise
+import Data.Either (Either(..))
 import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe(..))
 import Data.Nullable (Nullable)
-import Data.Nullable as Nullable
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (Aff, Error)
+import Effect.Exception (error)
 import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, runEffectFn3)
-import Fetch as Fetch
-import Fetch.Core.Response as YogaJson.Core
-import Fetch.Internal.Response as FetchInternalResponse
 import Foreign (Foreign)
 import Prim.Row (class Union)
-import Supabase.Types (Client)
-import Supabase.Util as Util
+import Supabase.Types (Channel, ChannelName, Client)
 import Type.Function (type ($))
 import Type.Row (type (+))
-import Yoga.JSON (class ReadForeign, class WriteForeign, write) as YogaJson
 import Yoga.JSON (class ReadForeign, class WriteForeign, writeImpl)
+import Fetch as Fetch
+import Fetch.Internal.Response as FetchInternalResponse
+import Data.Nullable as Nullable
+import Control.Promise as Promise
+import Supabase.Util as Util
+import Yoga.JSON (class ReadForeign, class WriteForeign, write) as YogaJson
+import Fetch.Core.Response as YogaJson.Core
 
 foreign import data QueryBuilder :: Type
 foreign import data FilterBuilder :: Type
@@ -169,7 +173,7 @@ foreign import onAuthStateChangeImpl :: Client -> (EffectFn1 (Nullable Session)
 onAuthStateChange ∷ Client → (Maybe Session → Effect Unit) → Effect { data :: { id :: String, unsubscribe :: Effect Unit } }
 onAuthStateChange client handler = onAuthStateChangeImpl client $ mkEffectFn1 (Nullable.toMaybe >>> handler)
 
-type User = { id :: String, email :: String }
+type User = { id :: String, email :: String, user_metadata :: Foreign }
 type Session = { user :: User }
 type SessionData = { session :: Maybe Session }
 
@@ -200,3 +204,16 @@ invoke client fn body headers = runFn3 (invokeImpl client) fn body headers # Pro
   where
   convertError { message, context } = { message, context: FetchInternalResponse.convert context }
   convert { "data": d, error } = { "data": Nullable.toMaybe d, error: Nullable.toMaybe error <#> convertError }
+
+foreign import channel :: ChannelName -> Client -> Effect Channel
+
+foreign import getUserImpl :: Client -> Effect (Promise { data :: Nullable User, error :: Nullable Error })
+
+getUser :: Client -> Aff (Either Error User)
+getUser client = do
+  res <- getUserImpl client # Promise.toAffE
+  case Nullable.toMaybe res.data, Nullable.toMaybe res.error of
+    Just user, _ -> pure $ Right user
+    _, Just error -> pure $ Left error
+    _, _ -> pure $ Left (error "Unexpected response error")
+

src/Supabase/Types.purs

@@ -1,7 +1,9 @@
-module Supabase.Types
-  ( Client
-  ) where
+module Supabase.Types where
 
 import Prelude
 
 foreign import data Client :: Type
+
+foreign import data Channel :: Type
+
+newtype ChannelName = ChannelName String