OAuth.purs

import Data.Argonaut.Core as J
import Data.Argonaut.Decode (class DecodeJson, decodeJson, getField)
import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson)
import Data.Argonaut.Encode (class EncodeJson)
import Data.Argonaut.Encode.Combinators ((:=), (~>))
import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe.First (First(..))

type OauthConnectionProps 
    = ( access_token  :: String
      , token_type    :: Maybe String
      , refresh_token :: Maybe String 
      , scope         :: Maybe String
      , state         :: Maybe String 
      , instance_url  :: String
      , id            :: String
      , issued_at     :: String 
      , signature     :: String 
      )

type OAuthConnectionErrorProps 
    = ( error             :: String
      , error_description :: Maybe String 
      , state             :: Maybe String
      )

data OAuthResponse 
    = OAuthConnection { | OauthConnectionProps }
    | OAuthConnectionError' { | OAuthConnectionErrorProps }
    
--- Not Working Approach   
instance decodeJsonOAuthResponse :: DecodeJson OAuthResponse where
  decodeJson json = do
    obj <- decodeJson json 
    
    let at  = setTagBy setOauthConnectionTag obj "access_token" 
        er  = setTagBy setOauthConnectionErrorTag obj "error" 

        l = [ First <<< hush $ at 
            , First <<< hush $ er 
            ]
        First (maybeJson) = foldl (<>) mempty $ l

    json' <- "Could not parse. access_token nor error token found." `getJsonWithErr`  maybeJson
    
    genericDecodeJson json'                              
        
    where 

        setTagBy :: (J.Json -> J.Json) -> Object J.Json -> String -> Either String J.Json
        setTagBy f obj t = f <$> getField obj t

        getJsonWithErr :: String -> Maybe J.Json -> Either String J.Json 
        getJsonWithErr err j =  case j of 
            Nothing    -> throwError err 
            Just json' -> pure json' 

        setOauthConnectionTag = \_ -> ( "tag"    := "OAuthConnection"
                                     ~> "values" := J.jsonSingletonArray json
                                     ~> J.jsonEmptyObject
                                     )  

        setOauthConnectionErrorTag = \_ -> ( "tag"    := "OAuthConnectionError'"
                                          ~> "values" := J.jsonSingletonArray json
                                          ~> J.jsonEmptyObject
                                           )  
                                           
--- Working Approach                            
instance decodeJsonOAuthResponse :: DecodeJson OAuthResponse where
  decodeJson json = do
    obj <- decodeJson json 
    
    let at  = setTagBy setOauthConnectionTag obj "access_token" 
        er  = setTagBy setOauthConnectionErrorTag obj "error" 

        l = [ First <<< hush $ at 
            , First <<< hush $ er 
            ]
        First (maybeOauthResponse) = foldl (<>) mempty $ l

    "Could not parse. access_token nor error token found." `getOauthResponseWithErr` maybeOauthResponse
                        
    where 
        setTagBy :: (Object J.Json -> String -> Either String OAuthResponse) -> Object J.Json -> String -> Either String OAuthResponse
        setTagBy f obj t = f obj =<< getField obj t

        getOauthResponseWithErr :: String -> Maybe OAuthResponse -> Either String OAuthResponse
        getOauthResponseWithErr err j =  case j of 
            Nothing    -> throwError err 
            Just json' -> pure json' 

        setOauthConnectionTag :: Object J.Json -> String -> Either String OAuthResponse
        setOauthConnectionTag obj' = \access_token -> do
            state <- getFieldOptional' obj' "state"
            token_type <- getFieldOptional' obj' "token_type"
            refresh_token <- getFieldOptional' obj' "refresh_token"
            scope <- getFieldOptional' obj' "scope"
            instance_url <- getField obj' "instance_url"
            id <- getField obj' "id"
            issued_at <- getField obj' "issued_at"
            signature <- getField obj' "signature"

            pure $ OAuthConnection {access_token, state, token_type, refresh_token, scope, instance_url, id, issued_at, signature}


        setOauthConnectionErrorTag :: Object J.Json -> String -> Either String OAuthResponse
        setOauthConnectionErrorTag obj' = \error -> do
            error_description <- getFieldOptional' obj' "error_description"
            state <- getFieldOptional' obj' "state"
            pure $ OAuthConnectionError' {error, error_description, state}

OAuthSpec.purs

module OAuthSpec where 

import Prelude
import OAuth
import Data.Argonaut.Core as J
import Data.Argonaut.Decode (decodeJson)
import Data.Argonaut.Encode (encodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect.Class.Console (log)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldContain, shouldEqual)


spec :: Spec Unit
spec = do
    describe "can decode OauthResponse to JSON from OAuth module" do
        it "decodeJson" do
            
            let eitherJson = jsonParser """{ "access_token": "sometoken", "token_type": "Bearer", "refresh_token": "sometoken", "instance_url": "someurl", "id": "someid", "issued_at": "somedate", "signature": "somesig" }"""
                u = decodeJson =<< eitherJson
            u `shouldEqual` (Right (OAuthConnection expectedConnAuth))

    where 
        expectedConnAuth = 
            { access_token  : "sometoken"
            , token_type    : Just "Bearer"
            , refresh_token : Just "sometoken" 
            , scope         : Nothing
            , state         : Nothing 
            , instance_url  : "someurl"
            , id            : "someid"
            , issued_at     : "somedate" 
            , signature     : "somesig" 
            }
            
            
---   (Left "When decoding a OAuthConnectionError': 'tag' property is missing") ≠ (Right (OAuthConnection { access_token: "sometoken", id: "someid", instance_url: "someurl", issued_at: "somedate", refresh_token: (Just "sometoken"), scope: Nothing, signature: "somesig", state: Nothing, token_type: (Just "Bearer") }))