HawkClient.hs

module HawkClient where

import           Control.Exception         as E
import           Control.Lens
import           Control.Monad             (void)
import           Data.ByteString           (ByteString)
import qualified Data.ByteString.Char8     as S8
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy      as BL
import           Data.Either               (isRight)
import qualified Data.Map                  as M
import qualified Data.Text                 as T
import           Data.Text.Encoding        (decodeUtf8, encodeUtf8)
import           Network.HTTP.Client       (HttpException(..), HttpExceptionContent(..))
import           Network.HTTP.Client       (responseStatus, responseHeaders)
import           Network.HTTP.Types.Header (ResponseHeaders, hAuthorization, hWWWAuthenticate)
import           Network.HTTP.Types.Status (Status(..))
import           Network.HTTP.Simple
import           Data.Monoid               ((<>))

import           Common
import           Network.Hawk
import qualified Network.Hawk.Client       as Hawk

uri = "http://localhost:8000/resource/1?b=1&a=2"
creds = Hawk.Credentials "dh37fgj492je" sharedKey (HawkAlgo SHA256)
ext = Just "some-app-data"
payload = PayloadInfo "" ""

clientMainSimple :: IO ()
clientMainSimple = do
  (arts, req) <- Hawk.sign creds ext (Just payload) 0 uri
  r <- httpLBS req

  res <- Hawk.authenticate r creds arts
         (Just $ getResponseBody r)
         Hawk.ServerAuthorizationRequired

  printResponse (isRight res) r

printResponse :: Bool -> Response BL.ByteString -> IO ()
printResponse valid r = putStrLn $ (show $ getResponseStatusCode r) ++ ": "
                        ++ L8.unpack (getResponseBody r)
                        ++ (if valid then " (valid)" else " (invalid)")

clientMain :: IO ()
clientMain = (withHawk httpLBS uri >>= printResponse True) `E.catches` handlers
  where
    withHawk = Hawk.withHawk creds ext (Just payload) Hawk.ServerAuthorizationRequired
    handlers = [E.Handler handleHTTP, E.Handler handleHawk]
    handleHTTP e@(HttpExceptionRequest _ (StatusCodeException res _))
      | unauthorized res = S8.putStrLn $ errMessage res
      | otherwise        = throwIO e
      where code = statusCode (responseStatus res)
    handleHawk (Hawk.HawkServerAuthorizationException e)
      = putStrLn $ "Invalid server response: " ++ e

unauthorized :: Response a -> Bool
unauthorized = (== 401) . statusCode . responseStatus

errMessage :: Response a -> ByteString
errMessage res = statusMessage s <> maybe "" (": " <>) authHdr
  where
    authHdr = lookup hWWWAuthenticate $ responseHeaders res
    s = responseStatus res