Skip to content

Instantly share code, notes, and snippets.

@pthariensflame
Last active November 7, 2019 10:58
Show Gist options
  • Star 14 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save pthariensflame/6057040 to your computer and use it in GitHub Desktop.
Save pthariensflame/6057040 to your computer and use it in GitHub Desktop.
An introduction to the indexed privilege monad in Haskell, Scala and C#.

The Indexed Privilege Monad in Haskell, Scala, and C#

We've already looked at two different indexed monads in our tour so far, so let's go for a third whose regular counterpart isn't as well known: the privilege monad.

Motivation

The regular privilege monad allows you to express constraints on which operations a given component is allowed to perform. This lets the developers of seperate interacting components be statically assured that other components can't access their private state, and it gives you a compile-time guarantee that any code that doesn't have appropriate permissions cannot do things that would require those permissions. Unfortunately, you cannot easily, and sometimes cannot at all, build code in the privilege monad that gains or loses permissions as the code runs; in other words, you cannot (in general) raise or lower your own privilege level, not even when it really should be allowed.

The indexed privilege monad gives you back those missing features. It always allows you to lower your own privilege level, and it also allows you to raise your own privilege level if you can supply an appropriate proof of permission. The core functionality of the indexed privilege monad is very flexible, so developers can plug in their own permission types. (In fact, they need to!)

NOTE: The indexed privilege monad presented here should really be a (indexed) monad transformer in order to accomodate different base sets of operations, but I'm trying to keep things focused here, not to mention the fact that C#'s lack of higher-kinded types prevents a transformer version from being written at all in that language. As a result, you will notice that the Haskell version incorporates the IO monad as a base; it is there that we would place the base monad parameter in the transformer, if we were to write it.

Implementation

First, the usual preliminary boilerplate:

Haskell:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
module IndexedPrivilege where
import Prelude hiding (fmap, (>>=), (>>), return)
import qualified Prelude as P
import Control.Exception (throwIO)

Scala:

package indexedPrivilege

C#:

using System;
using Unit = System.Reactive.Unit;

public namespace IndexedPrivilege
{
    // Copied from my indexed state monad tutorial; see there for rationale
    public interface Pair<out A, out B>
    {
        public A V1 { get; }
        public B V2 { get; }
    }
    public static class Pair
    {
        public static Pair<A, B> Create<A, B>(A a, B b)
        {
            return new PairImpl<A, B>(a, b);
        }
        private class PairImpl<A, B> : Pair<A, B>
        {
            private readonly A v1;
            private readonly B v2;
            public PairImpl(A a, B b)
            {
                v1 = a;
                v2 = b;
            }
            public A V1
            {
                get { return v1; }
            }
            public A V2
            {
                get { return v2; }
            }
        }
    }

We'll need a way to compare two privileges to see if one "implies" the other. In Haskell and Scala, this is also a type class; in C#, this is an evidence parameter, effectively a type class done manually:

Haskell:

class PImplies p1 p2 where
    transport :: p1 -> IO p2

instance PImplies p () where
    transport _ = P.return ()

instance PImplies (p1, p2) p1 where
    transport (p, _) = P.return p

instance PImplies (p1, p2) p2 where
    transport (_, p) = P.return p

Scala:

trait PImplies[P1, P2] {
  def transport(initial: P1): P2
}

object PImplies {
  implicit def noPermission[P]: PImplies[P, Unit] = new PImplies[P, Unit] {
    override def transport(initial: P) {}
  }
  
  implicit def firstPermission[P1, P2]: PImplies[(P1, P2), P1] = new PImplies[(P1, P2), P1] {
    override def transport(initial: (P1, P2)): P1 = initial._1
  }
  
  implicit def secondPermission[P1, P2]: PImplies[(P1, P2), P2] = new PImplies[(P1, P2), P2] {
    override def transport(initial: (P1, P2)): P2 = initial._2
  }
}

C#:

    public abstract class PImplies<P1, P2>
    {
        protected PImplies()
        {
            super();
        }
        
        public abstract P2 Transport(P1 initial);
    }
    
    public static class PImplies
    {
        private class NoPermissionInstance<P> : PImplies<P, Unit>
        {
            public NoPermissionInstance()
            {
                super();
            }
            
            public override Unit Transport(P initial)
            {
                return Unit.Default;
            }
        }
        
        public static PImplies<P,  Unit> NoPermission<P>()
        {
            return new NoPermissionInstance<P>();
        }
        
        private class FirstPermissionInstance<P1, P2> : PImplies<Pair<P1, P2>, P1>
        {
            public FirstPermissionInstance()
            {
                super();
            }
            
            public override P1 Transport(Pair<P1, P2> initial)
            {
                return inital.V1;
            }
        }
        
        public static PImplies<Pair<P1, P2>,  P1> FirstPermission<P1, P2>()
        {
            return new FirstPermissionInstance<P1, P2>();
        }
        
        private class SecondPermissionInstance<P1, P2> : PImplies<Pair<P1, P2>, P2>
        {
            public SecondPermissionInstance()
            {
                super();
            }
            
            public override P2 Transport(Pair<P1, P2> initial)
            {
                return inital.V2;
            }
        }
        
        public static PImplies<Pair<P1, P2>,  P2> SecondPermission<P1, P2>()
        {
            return new SecondPermissionInstance<P1, P2>();
        }
    }

Now we can build our indexed privilege monad! Conceptually, the privilege monad is a lot like the state monad, in that we take evidence that we have our initial level of privilege and return evidence that we have our final level of privilege. They have a somewhat different set of primitives, though, so we will implement IPrivilege directly anyway:

Haskell:

newtype IPrivilege pI pO a = IPrivilege { runIPrivilege :: pI -> IO (a, pO) }

runIPrivilege0 :: IPrivilege () pO a -> IO a
runIPrivilege0 a = fst $ runIPrivilege a ()

Scala:

final class IPrivilege[-Pi, +Po, +A](val run: Pi => (A, Po)) extends IPrivilegeMonadOps {
  def run0(implicit ev: Pi <:< Unit): A = this.run(())._1
}

object IPrivilege extends IPrivilegeMonadFuncs with IPrivilegeFuncs {
  def apply[Pi, Po, A](f: Pi => (A, Po)) = new IPrivilege[Pi, Po, A](f)
}

C#:

    public delegate Pair<A, Po> IPrivilege<in Pi, out Po, out A>(Pi initial);
    
    public static class IPrivilege
    {
        public static Pair<A, Po> Run<Pi, Po, A>(this IPrivilege<Pi, Po, A> a, Pi initial)
        {
            return a(initial);
        }
        
        public static A Run0<Po, A>(this IPrivilege<Unit, Po, A> a)
        {
            return a(Unit.Default)
        }

Now we need to implement the standard indexed monad operations, as usual:

Haskell:

-- unit
return :: a -> IPrivilege p p a
return x = IPrivilige $ \p -> (P.return x, p)

-- map
fmap :: (a -> b) -> IPrivilege pI pO a -> IPrivilege pI pO b
fmap f (IPrivilege k) = IPrivilege $ \p0 -> P.fmap (\(x, p1) -> (f x, p1)) $ k p0

-- join
join :: IPrivilege pI pM (IPrivilege pM pO a) -> IPrivilege pI pO a
join (IPrivilege k0) = IPrivilege $ \p0 -> k0 p0 P.>>= \(q, p1) -> runIPrivilege q p1

-- bind
(>>=) :: IPrivilege pI pM a -> (a -> IPrivilege pM pO b) -> IPrivilege pI pO b
IPrivilege k0 >>= f = IPrivilege $ \p0 -> k0 p0 P.>>= \(x, p1) -> runIPrivilege (f x) p1

-- then
(>>) :: IPrivilege pI pM a -> IPrivilege pM pO b -> IPrivilege pI pO b
IPrivilege k0 >> IPrivilege k1 = IPrivilege $ \p0 -> k0 p0 P.>>= \(_, p1) -> k1 p1

-- fail
fail :: String -> IPrivilege pI pO a
fail str = IPrivilege $ \_ -> throwIO str

-- liftIO (this is actually a monad transformer operation, but it's needed because of Haskell's purity)
liftIO :: IO a -> IPrivilege p p a
liftIO q = IPrivilege $ \p -> P.fmap (\x -> (x, p)) q

Scala:

private[indexedPrivilege] sealed trait IPrivilegeMonadFuncs { this: IPrivilege.type =>
  // unit
  def point[P, A](x: A): IPrivilege[P, P, A] = IPrivilege { p => (x, p) }
  
  // unit (lazy version)
  def pointL[P, A](x: => A): IPrivilege[P, P, A] = IPrivilege { p => (x, p) }
}
private[indexedPrivilege] sealed trait IPrivilegeMonadOps[-Pi, +Po, +A] { this: IPrivilege[Pi, Po, A] =>
  // map
  def map[A, B](f: A => B): IPrivilege[Pi, Po, A] = IPrivilege { p0 =>
    val (x, p1) = this.run(p0)
    (f(x), p1)
  }
  
  // join
  def flatten[Pe, B](implicit ev: A <:< IPrivilege[Po, Pe, B]): IPrivilege[Pi, Pe, B] = IPrivilege { p0 =>
    val (x, p1) = this.run(p0)
    ev(x).run(p1)
  }
  
  // join
  def flatMap[Pe, B](f: A => IPrivilege[Po, Pe, B]): IPrivilege[Pi, Pe, B] = IPrivilege { p0 =>
    val (x, p1) = this.run(p0)
    f(x).run(p1)
  }
}

C#:

        // unit
        public static IPrivilege<P, P, A> ToIPrivilege(this A x)
        {
            return (p => Pair.Create<A, P>(x, p);
        }
        
        // unit (lazy version)
        public static IPrivilege<P, P, A> Create(Func<A> t)
        {
            return (p => Pair.Create<A, P>(t(), p));
        }
        
        // map
        public static IPrivilege<Pi, Po, B> Select<Pi, Po, A, B>(this IPrivilege<Pi, Po, A> a, Func<A, B> f)
        {
            return (p0 =>
            {
                var x_p1 = a.Run(p0);
                return Pair.Create<B, Po>(f(x_p1.V1), x_p1.V2);
            });
        }
        
        // join
        public static IPrivilege<Pi, Po, A> Flatten<Pi, Pm, Po, A>(this IPrivilege<Pi, Pm, IPrivilege<Pm, Po, A>> a0)
        {
            return (p0 =>
            {
                var a1_p1 = a0.Run(p0);
                return a1_p1.V1.Run(a1_p1.V2);
            });
        }
        
        // bind
        public static IPrivilege<Pi, Po, B> SelectMany<Pi, Pm, Po, A, B>(this IPrivilege<Pi, Pm, A> a0, Func<A, IPrivilege<Pm, Po, B>> f)
        {
            return (p0 =>
            {
                var x_p1 = a0.Run(p0);
                return f(x_p1.V1).Run(a1_p1.V2);
            });
        }
        
        // bindMap
        public static IPrivilege<Pi, Po, C> SelectMany<Pi, Pm, Po, A, B, C>(this IPrivilege<Pi, Pm, A> a0, Func<A, IPrivilege<Pm, Po, B>> f, Func<A, B, C> s)
        {
            return (p0 =>
            {
                var x_p1 = a0.Run(p0);
                var x = x_p1.V1;
                var y_p2 = f(x).Run(x_p1.V2);
                return Pair.Create<C, Po>(s(x, y_p2.V1), y_p2.V2);
            });
        }

Now we implement the primitives of the indexed privilege monad:

Haskell:

raise :: (pI -> IO pO) -> IPrivilege pI pO ()
raise f = IPrivilege $ \p0 -> P.fmap (\p1 -> ((), p1)) $ f p0

lower :: (PImplies pI pO) => IPrivilege pI pO ()
lower = raise transport

Scala:

private[indexedPrivilege] sealed trait IPrivilegeFuncs { this: IPrivilege.type =>
    def raise[Pi, Po](f: Pi => Po): IPrivilege[Pi, Po, Unit] = IPrivilege { p => ((), f(p)) }
    
    def lower[Pi, Po](implicit PI: PImplies[Pi, Po]): IPrivilege[Pi, Po, Unit] = IPrivilege.raise { PI.transport(_) }
}

C#:

        public static IPrivilege<Pi, Po, Unit> Raise<Pi, Po>(Func<Pi, Po> f)
        {
            return (p => Pair.Create<Unit, Po>(Unit.Default, f(p)));
        }
        
        public static IPrivilege<Pi, Po, Unit> Lower<Pi, Po>(PImplies<Pi, Po> PI)
        {
            return IPrivilege.Raise<Pi, Po>(i => PI.Transport(i));
        }
    }
}

That's it! Now we can use our indexed privilege monad.

Usage

In order to use our indexed privilege monad, we need to define some permissions to work with. We can already express "I have no permissions" with the unit type, and we can already combine multiple permissions with pairs. All that remains is to inform our system of the individual domain-specific permissions that could come into play. I will use the simple example of a channel of integer values that can be arbitrarily read from or arbitrarily written to, but not both at once. To demonstrate switching permissions, we will allow ourselves to "toggle" the channel between read-mode and write-mode:

Haskell:

{-# LANGUAGE RebindableSyntax #-}
import Prelude hiding (fmap, (>>=), (>>), return)
import IndexedPrivilege

data PRead = PRead

data PWrite = PWrite

readValue :: IPrivilege PRead PRead Int
readValue = {- read a value -}

stopReading :: IPrivilege PRead PWrite ()
stopReading = {- switch to write-mode -}

writeValue :: Int -> IPrivilege PWrite PWrite ()
writeValue i = {- write the value 'i' -}

stopWriting :: IPrivilige PWrite PRead ()
stopWriting = {- switch to read-mode -}

Scala:

import indexedPrivilege

object ChannelOps {
  case object PRead
  
  case object PWrite
  
  val readValue: IPrivilege PRead PRead Int = /* read a value */
  
  val stopReading: IPrivilege PRead PWrite Unit = /* switch to write-mode */
  
  def writeValue(i: Int): IPrivilege PWrite PWrite Unit = /* write the value `i`*/
  
  val stopWriting: IPrivilege PWrite PRead Unit = /* switch to read-mode */
}

C#:

using System;
using Unit = System.Reactive.Unit;
using IndexedPrivilege

public namespace Example {
    public static class ChannelOps
    {
        public sealed class PRead
        {
            private static volatile PRead instance;
            
            private static object syncRoot = new Object();
            
            private PRead() {}
            
            public static PRead Instance
            {
                get
                {
                    if (instance == null)
                    {
                        lock (syncRoot)
                        {
                            if (instance == null)
                                instance = new PRead();
                        }
                    }
                    
                    return instance;
                }
            }
        }
        
        public sealed class PWrite
        {
            private static volatile PWrite instance;
            
            private static object syncRoot = new Object();
            
            private PWrite() {}
            
            public static PWrite Instance
            {
                get
                {
                    if (instance == null)
                    {
                        lock (syncRoot)
                        {
                            if (instance == null)
                                instance = new PWrite();
                        }
                    }
                    
                    return instance;
                }
            }
        }
        
        public static IPrivilege<PRead, PRead, int> ReadValue() { /* read a value */ }
        
        public static IPrivilege<PRead, PWrite, Unit> StopReading() { /* switch to write-mode */ }
        
        public static IPrivilege<PWrite, PWrite, Unit> WriteValue(int i) { /* write the value <c>i</c> */ }
        
        public static IPrivilege<PWrite, PRead, Unit> StopWriting() { /* switch to read-mode */ }
    }

Now, we can write 42 to the channel, read back two values, write the second value back twice, and finally return the first value:

Haskell:

figureOutTheQuestion :: IPrivilege PWrite PWrite Int
figureOutTheQuestion = do writeValue 42
                          stopWriting
                          x <- readValue
                          y <- readValue
                          stopReading
                          writeValue y
                          writeValue y
                          return x

Scala:

object Life_TheUniverse_AndEverything {
  import ChannelOps._
  
  val figureOutTheQuestion: IPrivilege[PWrite, PWrite, Int] = for {
    _ <- writeValue(42)
    _ <- stopWriting
    x <- readValue
    y <- readValue
    _ <- stopReading
    _ <- writeValue(y)
    _ <- writeValue(y)
  } yield x
}

C#:

    public static class Life_TheUniverse_AndEverything
    {
        public static IPrivilige<ChannelOps.PWrite, ChannelOps.PWrite, int> FigureOutTheQuestion()
        {
            return (from   _u0 in ChannelOps.WriteValue(42)
                    from   _u1 in ChannelOps.StopWriting()
                    from   x   in ChannelOps.ReadValue()
                    from   y   in ChannelOps.ReadValue()
                    from   _u2 in ChannelOps.StopReading()
                    from   _u3 in ChannelOps.WriteValue(y)
                    from   _u4 in ChannelOps.WriteValue(y)
                    select x);
        }
    }
}
@dima-starosud
Copy link

Amazing! Good start for linear typing library.
(And it is still State monad!!!)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment