Test.hs

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE QuasiQuotes         #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Security.AccessTokenProvider.Internal.Providers.Test
  ( securityAccessTokenProviderInternalProvidersTest
  ) where

import           Control.Exception.Safe
import           Control.Lens
import           Control.Monad.IO.Class
import qualified Data.ByteString.Lazy                       as ByteString.Lazy
import           Data.Format
import qualified Data.List.NonEmpty                         as NonEmpty
import qualified Data.Map.Strict                            as Map
import           Data.Semigroup
import qualified Data.Text.Encoding                         as Text
import           Data.UUID                                  (UUID)
import           Network.HTTP.Client.Internal
import           Network.HTTP.Types.Status
import           Network.HTTP.Types.Version
import           System.Random
import           Test.Tasty
import           Test.Tasty.HUnit

import           Security.AccessTokenProvider
import qualified Security.AccessTokenProvider               as ATP
import           Security.AccessTokenProvider.Internal.Util
import           Test

securityAccessTokenProviderInternalProvidersTest :: [TestTree]
securityAccessTokenProviderInternalProvidersTest =
  [ testGroup "Security.AccessTokenProvider.Internal.Providers"
    [ testCase "SimpleFixed Provider reads from TOKEN"
        simpleFixedProviderReadsFromToken
    , testCase "Fixed Provider reads from ATP_CONF_FIXED"
        fixedProviderReadsFromConf
    , testCase "Fixed Provider reads from ATP_CONF_FIXED and lookup fails"
        fixedProviderReadsFromConfLookupFails
    , testCase "File Provider reads from ATP_CONF_FILE"
        fileProviderReadsFromConf
    , testCase "File Provider reads from ATP_CONF_FILE and lookup fails"
        fileProviderReadsFromConfLookupFails
    , testCase "Ropcg Provider reads from ATP_CONF_ROPCG"
        ropcgProviderReadsFromConf
    ]
  ]

simpleFixedProviderReadsFromToken :: Assertion
simpleFixedProviderReadsFromToken = do
  token <- tshow <$> (randomIO :: IO UUID)
  let testState = TestState
                  { _testStateFilesystem = Map.empty
                  , _testStateEnvironment = Map.fromList [ ("TOKEN", token) ]
                  , _testStateHttpResponse = Nothing
                  , _testStateHttpRequests = []
                  , _testStateLog = []
                  }
  evalTestStack testState $ do
    tokenProvider <- newWithProviders mockBackend
                     (defaultProviders <> pure probeProviderSimpleFixed)
                     (AccessTokenName "some-random-token-name")
    (AccessToken token') <- retrieveAccessToken tokenProvider
    liftIO $ token @=? token'

fixedProviderReadsFromConf :: Assertion
fixedProviderReadsFromConf = do
  token <- tshow <$> (randomIO :: IO UUID)
  let conf = [fmt|{"tokens": {"label1": "$token"}}|]
      testState = TestState
                  { _testStateFilesystem = Map.empty
                  , _testStateEnvironment = Map.fromList [ ("ATP_CONF_FIXED", conf) ]
                  , _testStateHttpResponse = Nothing
                  , _testStateHttpRequests = []
                  , _testStateLog = []
                  }
  evalTestStack testState $ do
    tokenProvider <- newWithBackend mockBackend (AccessTokenName "label1")
    (AccessToken token') <- retrieveAccessToken tokenProvider
    liftIO $ token @=? token'

fixedProviderReadsFromConfLookupFails :: Assertion
fixedProviderReadsFromConfLookupFails = do
  token <- tshow <$> (randomIO :: IO UUID)
  let conf = [fmt|{"tokens": {"label1": "$token"}}|]
      testState = TestState
                  { _testStateFilesystem = Map.empty
                  , _testStateEnvironment = Map.fromList [ ("ATP_CONF_FIXED", conf) ]
                  , _testStateHttpResponse = Nothing
                  , _testStateHttpRequests = []
                  , _testStateLog = []
                  }
  evalTestStack testState $ do
    Left _ <- tryAny $ newWithBackend mockBackend (AccessTokenName "label2")
    pure ()

fileProviderReadsFromConf :: Assertion
fileProviderReadsFromConf = do
  tokenText <- tshow <$> (randomIO :: IO UUID)
  let tokenBytes = Text.encodeUtf8 tokenText
      filename = "/a/b/c"
      conf = [fmt|{"tokens": {"label1": "$filename"}}|]
      testState = TestState
                  { _testStateFilesystem =
                      Map.fromList [ (filename, tokenBytes) ]
                  , _testStateEnvironment =
                      Map.fromList [ ("ATP_CONF_FILE", conf) ]
                  , _testStateHttpResponse = Nothing
                  , _testStateHttpRequests = []
                  , _testStateLog = []
                  }
  evalTestStack testState $ do
    tokenProvider <- newWithBackend mockBackend (AccessTokenName "label1")
    (AccessToken token') <- retrieveAccessToken tokenProvider
    liftIO $ tokenText @=? token'

fileProviderReadsFromConfLookupFails :: Assertion
fileProviderReadsFromConfLookupFails = do
  tokenText <- tshow <$> (randomIO :: IO UUID)
  let tokenBytes = Text.encodeUtf8 tokenText
      filename = "/a/b/c"
      conf = [fmt|{"tokens": {"label1": "$filename"}}|]
      testState = TestState
                  { _testStateFilesystem =
                      Map.fromList [ (filename, tokenBytes) ]
                  , _testStateEnvironment =
                      Map.fromList [ ("ATP_CONF_FILE", conf) ]
                  , _testStateHttpResponse = Nothing
                  , _testStateHttpRequests = []
                  , _testStateLog = []
                  }
  evalTestStack testState $ do
    Left _ <- tryAny $ newWithBackend mockBackend (AccessTokenName "label2")
    pure ()

ropcgProviderReadsFromConf :: Assertion
ropcgProviderReadsFromConf = do
  tokenText <- tshow <$> (randomIO :: IO UUID)
  let conf = [fmt|{ "provider": "ropcg",
                    "credentials_directory": "/credentials",
                    "auth_endpoint": "https://localhost",
                    "tokens": {"label1": {"scopes": ["foo"]}}
                  }|]
      rspBody = ByteString.Lazy.fromStrict . Text.encodeUtf8 $
        [fmt|{"scope":        "foo",
              "expires_in":   60,
              "token_type":   "test",
              "access_token": "$tokenText"
             }|]
      response = Response { responseStatus    = ok200
                          , responseVersion   = http20
                          , responseHeaders   = []
                          , responseBody      = rspBody
                          , responseCookieJar = CJ []
                          , responseClose'    = ResponseClose (pure ())
                          }
      userCredentials =
        "{ \"application_username\": \"some-application-username\", \
        \  \"application_password\": \"some-application-password\" }"
      clientCredentials =
        "{ \"client_id\":     \"some-client-id\", \
        \  \"client_secret\": \"some-client-secret\" }"

      testState = TestState
                  { _testStateFilesystem   = Map.fromList
                    [ ("/credentials/user.json",   userCredentials)
                    , ("/credentials/client.json", clientCredentials)
                    ]
                  , _testStateEnvironment  = Map.fromList [ ("ATP_CONF_ROPCG", conf) ]
                  , _testStateHttpResponse = Just response
                  , _testStateHttpRequests = []
                  , _testStateLog = []
                  }
  (_, testState') <- runTestStack testState $ do
    tokenProvider <- newWithBackend mockBackend (AccessTokenName "label1")
    (AccessToken token) <- retrieveAccessToken tokenProvider
    liftIO $ tokenText @=? token
    pure ()
  1 @=? length (testState'^.testStateHttpRequests)
  pure ()

retrieveSomeToken :: IO ()
retrieveSomeToken = do
  tokenProvider <- ATP.new (AccessTokenName "token-name")
  token <- ATP.retrieveAccessToken tokenProvider
  print token