diff --git a/spago.dhall b/spago.dhall index 5988732..90bc83d 100644 --- a/spago.dhall +++ b/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" ] diff --git a/src/Supabase/AuthHelpers.js b/src/Supabase/AuthHelpers.js index 64aeb64..b2bdeba 100644 --- a/src/Supabase/AuthHelpers.js +++ b/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(); diff --git a/src/Supabase/AuthHelpers.purs b/src/Supabase/AuthHelpers.purs index ba0b181..0f90959 100644 --- a/src/Supabase/AuthHelpers.purs +++ b/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 diff --git a/src/Supabase/Realtime.js b/src/Supabase/Realtime.js new file mode 100644 index 0000000..1034aca --- /dev/null +++ b/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) diff --git a/src/Supabase/Realtime.purs b/src/Supabase/Realtime.purs new file mode 100644 index 0000000..042272e --- /dev/null +++ b/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 diff --git a/src/Supabase/Realtime/ListenType.purs b/src/Supabase/Realtime/ListenType.purs new file mode 100644 index 0000000..5d08edf --- /dev/null +++ b/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" diff --git a/src/Supabase/Realtime/SubscribeStates.purs b/src/Supabase/Realtime/SubscribeStates.purs new file mode 100644 index 0000000..5f79bd3 --- /dev/null +++ b/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 + diff --git a/src/Supabase/Supabase.js b/src/Supabase/Supabase.js index 7edbd55..951d89a 100644 --- a/src/Supabase/Supabase.js +++ b/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); diff --git a/src/Supabase/Supabase.purs b/src/Supabase/Supabase.purs index 9e629fd..8cf6b3f 100644 --- a/src/Supabase/Supabase.purs +++ b/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") + diff --git a/src/Supabase/Types.purs b/src/Supabase/Types.purs index 74ebdf3..24b6a73 100644 --- a/src/Supabase/Types.purs +++ b/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