-
Notifications
You must be signed in to change notification settings - Fork 1
/
Credentials.purs
37 lines (30 loc) · 1.37 KB
/
Credentials.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
module Credentials where
import Prelude
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.String.Base64 (decode, encode)
import Data.String.Common (split, toLower) as String
import Data.String.CodePoints (drop, take) as String
import Data.String.Pattern (Pattern(..))
import Data.Tuple (Tuple(..), fst, snd)
import Effect.Exception (message)
import Type.Trout.Header (class FromHeader, class ToHeader)
newtype Credentials = Credentials (Tuple String String)
mkCredentials :: String -> String -> Credentials
mkCredentials u p = Credentials $ Tuple u p
username :: Credentials -> String
username (Credentials c) = fst c
password :: Credentials -> String
password (Credentials c) = snd c
instance fromHeaderCredentials :: FromHeader Credentials where
fromHeader headerValue
| String.toLower (String.take 6 headerValue) /= "basic " = Left "Only Basic authorization is supported."
| otherwise = do
payload <- lmap (\e -> "Failed to decode header: " <> message e) $ decode (String.drop 6 headerValue)
case String.split (Pattern ":") payload of
[ user, pass ] ->
pure $ Credentials (Tuple user pass)
_ ->
Left "The Authorization header is invalid."
instance toHeaderCredentials :: ToHeader Credentials where
toHeader credentials = "Basic " <> encode (username credentials <> ":" <> password credentials)